mirror of
https://github.com/unisonweb/unison.git
synced 2024-09-21 07:17:25 +03:00
Move and rename all '*0' combinators into the Names module
This commit is contained in:
Chris Penner
parent
60161107a0
commit
ca9e834849
@ -43,8 +43,7 @@ import qualified Unison.Var as Var
|
||||
import Unison.Name ( Name )
|
||||
import qualified Unison.Name as Name
|
||||
import Unison.NamesWithHistory (NamesWithHistory(..))
|
||||
import Unison.Names (Names)
|
||||
import qualified Unison.NamesWithHistory as NamesWithHistory
|
||||
import Unison.Names (Names (Names))
|
||||
import qualified Unison.Typechecker.TypeLookup as TL
|
||||
import qualified Unison.Util.Relation as Rel
|
||||
import qualified Unison.Hashing.V2.Convert as H
|
||||
@ -57,7 +56,7 @@ names :: NamesWithHistory
|
||||
names = NamesWithHistory names0 mempty
|
||||
|
||||
names0 :: Names
|
||||
names0 = NamesWithHistory.names0 terms types where
|
||||
names0 = Names terms types where
|
||||
terms = Rel.mapRan Referent.Ref (Rel.fromMap termNameRefs) <>
|
||||
Rel.fromList [ (Name.fromVar vc, Referent.Con (R.DerivedId r) cid ct)
|
||||
| (ct, (_,(r,decl))) <- ((CT.Data,) <$> builtinDataDecls @Symbol) <>
|
||||
|
||||
@ -87,4 +87,4 @@ findInHistory termMatches typeMatches queries b =
|
||||
then (Set.delete q remainingSHs, Names.addType n r names0) else acc
|
||||
|
||||
namesDiff :: Branch m -> Branch m -> Names.Diff
|
||||
namesDiff b1 b2 = Names.diff0 (toNames (head b1)) (toNames (head b2))
|
||||
namesDiff b1 b2 = Names.diff (toNames (head b1)) (toNames (head b2))
|
||||
|
||||
@ -1439,7 +1439,7 @@ loop = do
|
||||
termDeprecations :: [(Name, Referent)]
|
||||
termDeprecations =
|
||||
[ (n, r) | (oldTypeRef,_) <- Map.elems typeEdits
|
||||
, (n, r) <- NamesWithHistory.constructorsForType0 oldTypeRef currentPathNames ]
|
||||
, (n, r) <- Names.constructorsForType oldTypeRef currentPathNames ]
|
||||
|
||||
ye'ol'Patch <- getPatchAt patchPath
|
||||
-- If `uf` updates a -> a', we want to replace all (a0 -> a) in patch
|
||||
@ -1735,7 +1735,7 @@ loop = do
|
||||
tm (Referent.Con r _i _ct) = eval $ GetDependents r
|
||||
in LD.fold tp tm ld
|
||||
(missing, names0) <- eval . Eval $ Branch.findHistoricalRefs' dependents root'
|
||||
let types = R.toList $ NamesWithHistory.types0 names0
|
||||
let types = R.toList $ Names.types names0
|
||||
let terms = fmap (second Referent.toReference) $ R.toList $ Names.terms names0
|
||||
let names = types <> terms
|
||||
numberedArgs .= fmap (Text.unpack . Reference.toText) ((fmap snd names) <> toList missing)
|
||||
@ -1761,7 +1761,7 @@ loop = do
|
||||
tm _ = pure mempty
|
||||
in LD.fold tp tm ld
|
||||
(missing, names0) <- eval . Eval $ Branch.findHistoricalRefs' dependencies root'
|
||||
let types = R.toList $ NamesWithHistory.types0 names0
|
||||
let types = R.toList $ Names.types names0
|
||||
let terms = fmap (second Referent.toReference) $ R.toList $ Names.terms names0
|
||||
let names = types <> terms
|
||||
numberedArgs .= fmap (Text.unpack . Reference.toText) ((fmap snd names) <> toList missing)
|
||||
@ -1886,8 +1886,8 @@ resolveHQToLabeledDependencies = \case
|
||||
HQ.NameOnly n -> do
|
||||
parseNames <- basicParseNames
|
||||
let terms, types :: Set LabeledDependency
|
||||
terms = Set.map LD.referent . Name.searchBySuffix n $ NamesWithHistory.terms0 parseNames
|
||||
types = Set.map LD.typeRef . Name.searchBySuffix n $ NamesWithHistory.types0 parseNames
|
||||
terms = Set.map LD.referent . Name.searchBySuffix n $ Names.terms parseNames
|
||||
types = Set.map LD.typeRef . Name.searchBySuffix n $ Names.types parseNames
|
||||
pure $ terms <> types
|
||||
-- rationale: the hash should be unique enough that the name never helps
|
||||
HQ.HashQualified _n sh -> resolveHashOnly sh
|
||||
@ -2732,7 +2732,7 @@ loadDisplayInfo refs = do
|
||||
-- then name foo.bar.baz becomes baz
|
||||
-- name cat.dog becomes .cat.dog
|
||||
fixupNamesRelative :: Path.Absolute -> Names -> Names
|
||||
fixupNamesRelative currentPath' = NamesWithHistory.map0 fixName where
|
||||
fixupNamesRelative currentPath' = Names.map fixName where
|
||||
prefix = Path.toName (Path.unabsolute currentPath')
|
||||
fixName n = if currentPath' == Path.absoluteEmpty then n else
|
||||
fromMaybe (Name.makeAbsolute n) (Name.stripNamePrefix prefix n)
|
||||
@ -2744,7 +2744,7 @@ makeHistoricalParsingNames lexedHQs = do
|
||||
basicNames <- basicParseNames
|
||||
currentPath <- use currentPath
|
||||
pure $ NamesWithHistory basicNames
|
||||
(NamesWithHistory.makeAbsolute0 rawHistoricalNames <>
|
||||
(Names.makeAbsolute rawHistoricalNames <>
|
||||
fixupNamesRelative currentPath rawHistoricalNames)
|
||||
|
||||
loadTypeDisplayObject
|
||||
|
||||
@ -3,7 +3,7 @@ module Unison.Codebase.Editor.TodoOutput where
|
||||
|
||||
import Unison.Prelude
|
||||
|
||||
import qualified Unison.NamesWithHistory as Names
|
||||
import qualified Unison.Names as Names
|
||||
import qualified Unison.Type as Type
|
||||
import qualified Unison.Util.Relation as R
|
||||
import qualified Unison.Codebase.Patch as Patch
|
||||
@ -50,8 +50,8 @@ labeledDependencies TodoOutput{..} = Set.fromList (
|
||||
[LD.typeRef r | (_, _, UserObject d) <- snd todoFrontierDependents
|
||||
, r <- toList (DD.declDependencies d)]) <>
|
||||
-- name conflicts
|
||||
Set.map LD.referent (R.ran (Names.terms0 nameConflicts)) <>
|
||||
Set.map LD.typeRef (R.ran (Names.types0 nameConflicts)) <>
|
||||
Set.map LD.referent (R.ran (Names.terms nameConflicts)) <>
|
||||
Set.map LD.typeRef (R.ran (Names.types nameConflicts)) <>
|
||||
Patch.labeledDependencies editConflicts
|
||||
|
||||
noConflicts :: TodoOutput v a -> Bool
|
||||
|
||||
@ -20,11 +20,11 @@ import qualified Unison.Codebase.Runtime as Runtime
|
||||
import Unison.Codebase.Runtime ( Runtime )
|
||||
import Unison.Var ( Var )
|
||||
import qualified Unison.PrettyPrintEnv as PPE
|
||||
import qualified Unison.NamesWithHistory as NamesWithHistory
|
||||
import qualified Unison.Codebase.Branch as Branch
|
||||
import qualified Unison.Codebase.Branch.Names as Branch
|
||||
import System.Exit (die)
|
||||
import Control.Exception (finally)
|
||||
import qualified Unison.Names as Names
|
||||
|
||||
execute
|
||||
:: Var v
|
||||
@ -42,7 +42,7 @@ execute codebase runtime mainName =
|
||||
die ("Couldn't load root branch " ++ show h)
|
||||
Left (Codebase.CouldntParseRootBranch h) ->
|
||||
die ("Couldn't parse root branch head " ++ show h)
|
||||
let parseNames = NamesWithHistory.makeAbsolute0 (Branch.toNames (Branch.head root))
|
||||
let parseNames = Names.makeAbsolute (Branch.toNames (Branch.head root))
|
||||
loadTypeOfTerm = Codebase.getTypeOfTerm codebase
|
||||
let mainType = Runtime.mainType runtime
|
||||
mt <- getMainTerm loadTypeOfTerm parseNames mainName mainType
|
||||
|
||||
@ -1942,21 +1942,21 @@ prettyDiff diff = let
|
||||
adds = Names.addedNames diff
|
||||
removes = Names.removedNames diff
|
||||
|
||||
addedTerms = [ (n,r) | (n,r) <- R.toList (Names.terms0 adds)
|
||||
, not $ R.memberRan r (Names.terms0 removes) ]
|
||||
addedTypes = [ (n,r) | (n,r) <- R.toList (Names.types0 adds)
|
||||
, not $ R.memberRan r (Names.types0 removes) ]
|
||||
addedTerms = [ (n,r) | (n,r) <- R.toList (Names.terms adds)
|
||||
, not $ R.memberRan r (Names.terms removes) ]
|
||||
addedTypes = [ (n,r) | (n,r) <- R.toList (Names.types adds)
|
||||
, not $ R.memberRan r (Names.types removes) ]
|
||||
added = sort (hqTerms ++ hqTypes)
|
||||
where
|
||||
hqTerms = [ Names.hqName adds n (Right r) | (n, r) <- addedTerms ]
|
||||
hqTypes = [ Names.hqName adds n (Left r) | (n, r) <- addedTypes ]
|
||||
|
||||
removedTerms = [ (n,r) | (n,r) <- R.toList (Names.terms0 removes)
|
||||
, not $ R.memberRan r (Names.terms0 adds)
|
||||
removedTerms = [ (n,r) | (n,r) <- R.toList (Names.terms removes)
|
||||
, not $ R.memberRan r (Names.terms adds)
|
||||
, Set.notMember n addedTermsSet ] where
|
||||
addedTermsSet = Set.fromList (map fst addedTerms)
|
||||
removedTypes = [ (n,r) | (n,r) <- R.toList (Names.types0 removes)
|
||||
, not $ R.memberRan r (Names.types0 adds)
|
||||
removedTypes = [ (n,r) | (n,r) <- R.toList (Names.types removes)
|
||||
, not $ R.memberRan r (Names.types adds)
|
||||
, Set.notMember n addedTypesSet ] where
|
||||
addedTypesSet = Set.fromList (map fst addedTypes)
|
||||
removed = sort (hqTerms ++ hqTypes)
|
||||
@ -1964,20 +1964,20 @@ prettyDiff diff = let
|
||||
hqTerms = [ Names.hqName removes n (Right r) | (n, r) <- removedTerms ]
|
||||
hqTypes = [ Names.hqName removes n (Left r) | (n, r) <- removedTypes ]
|
||||
|
||||
movedTerms = [ (n,n2) | (n,r) <- R.toList (Names.terms0 removes)
|
||||
movedTerms = [ (n,n2) | (n,r) <- R.toList (Names.terms removes)
|
||||
, n2 <- toList (R.lookupRan r (Names.terms adds)) ]
|
||||
movedTypes = [ (n,n2) | (n,r) <- R.toList (Names.types removes)
|
||||
, n2 <- toList (R.lookupRan r (Names.types adds)) ]
|
||||
moved = Name.sortNamed fst . nubOrd $ (movedTerms <> movedTypes)
|
||||
|
||||
copiedTerms = List.multimap [
|
||||
(n,n2) | (n2,r) <- R.toList (Names.terms0 adds)
|
||||
, not (R.memberRan r (Names.terms0 removes))
|
||||
, n <- toList (R.lookupRan r (Names.terms0 orig)) ]
|
||||
(n,n2) | (n2,r) <- R.toList (Names.terms adds)
|
||||
, not (R.memberRan r (Names.terms removes))
|
||||
, n <- toList (R.lookupRan r (Names.terms orig)) ]
|
||||
copiedTypes = List.multimap [
|
||||
(n,n2) | (n2,r) <- R.toList (Names.types0 adds)
|
||||
, not (R.memberRan r (Names.types0 removes))
|
||||
, n <- toList (R.lookupRan r (Names.types0 orig)) ]
|
||||
(n,n2) | (n2,r) <- R.toList (Names.types adds)
|
||||
, not (R.memberRan r (Names.types removes))
|
||||
, n <- toList (R.lookupRan r (Names.types orig)) ]
|
||||
copied = Name.sortNamed fst $
|
||||
Map.toList (Map.unionWith (<>) copiedTerms copiedTypes)
|
||||
in
|
||||
|
||||
@ -32,7 +32,8 @@ import qualified Unison.Util.List as List
|
||||
import Unison.Var (Var)
|
||||
import qualified Unison.Var as Var
|
||||
import qualified Unison.WatchKind as UF
|
||||
import qualified Unison.NamesWithHistory as Names
|
||||
import qualified Unison.NamesWithHistory as NamesWithHistory
|
||||
import qualified Unison.Names as Names
|
||||
import qualified Unison.Names.ResolutionResult as Names
|
||||
import qualified Unison.Name as Name
|
||||
|
||||
@ -46,12 +47,12 @@ file = do
|
||||
-- which are parsed and applied to the type decls and term stanzas
|
||||
(namesStart, imports) <- TermParser.imports <* optional semi
|
||||
(dataDecls, effectDecls, parsedAccessors) <- declarations
|
||||
env <- case environmentFor (Names.currentNames namesStart) dataDecls effectDecls of
|
||||
env <- case environmentFor (NamesWithHistory.currentNames namesStart) dataDecls effectDecls of
|
||||
Right (Right env) -> pure env
|
||||
Right (Left es) -> P.customFailure $ TypeDeclarationErrors es
|
||||
Left es -> resolutionFailures (toList es)
|
||||
let importNames = [(Name.fromVar v, Name.fromVar v2) | (v,v2) <- imports ]
|
||||
let locals = Names.importing0 importNames (UF.names env)
|
||||
let locals = Names.importing importNames (UF.names env)
|
||||
-- At this stage of the file parser, we've parsed all the type and ability
|
||||
-- declarations. The `Names.push (Names.suffixify0 locals)` here has the effect
|
||||
-- of making suffix-based name resolution prefer type and constructor names coming
|
||||
@ -59,7 +60,7 @@ file = do
|
||||
--
|
||||
-- There's some more complicated logic below to have suffix-based name resolution
|
||||
-- make use of _terms_ from the local file.
|
||||
local (\e -> e { names = Names.push locals namesStart }) $ do
|
||||
local (\e -> e { names = NamesWithHistory.push locals namesStart }) $ do
|
||||
names <- asks names
|
||||
stanzas0 <- sepBy semi stanza
|
||||
let stanzas = fmap (TermParser.substImports names imports) <$> stanzas0
|
||||
@ -76,7 +77,7 @@ file = do
|
||||
-- suffixified local term bindings shadow any same-named thing from the outer codebase scope
|
||||
-- example: `foo.bar` in local file scope will shadow `foo.bar` and `bar` in codebase scope
|
||||
let (curNames, resolveLocals) =
|
||||
( Names.shadowTerms0 locals (Names.currentNames names)
|
||||
( Names.shadowTerms locals (NamesWithHistory.currentNames names)
|
||||
, resolveLocals )
|
||||
where
|
||||
-- All locally declared term variables, running example:
|
||||
|
||||
@ -93,7 +93,7 @@ resolveNames typeLookupf preexistingNames uf = do
|
||||
let tm = UF.typecheckingTerm uf
|
||||
deps = Term.dependencies tm
|
||||
possibleDeps = [ (Name.toText name, Var.name v, r) |
|
||||
(name, r) <- Rel.toList (NamesWithHistory.terms0 preexistingNames),
|
||||
(name, r) <- Rel.toList (Names.terms preexistingNames),
|
||||
v <- Set.toList (Term.freeVars tm),
|
||||
name `Name.endsWithSegments` Name.fromVar v ]
|
||||
possibleRefs = Referent.toReference . view _3 <$> possibleDeps
|
||||
@ -116,7 +116,7 @@ resolveNames typeLookupf preexistingNames uf = do
|
||||
let nr = Typechecker.NamedReference name typ (Right r) ] <>
|
||||
-- local file TDNR possibilities
|
||||
[ (Var.name v, nr) |
|
||||
(name, r) <- Rel.toList (NamesWithHistory.terms0 $ UF.toNames uf),
|
||||
(name, r) <- Rel.toList (Names.terms $ UF.toNames uf),
|
||||
v <- Set.toList (Term.freeVars tm),
|
||||
name `Name.endsWithSegments` Name.fromVar v,
|
||||
typ <- toList $ TL.typeOfReferent tl r,
|
||||
|
||||
@ -127,14 +127,14 @@ basicNames' root path = (parseNames0, prettyPrintNames0)
|
||||
where
|
||||
root0 = Branch.head root
|
||||
currentBranch = fromMaybe Branch.empty $ Branch.getAt path root
|
||||
absoluteRootNames = NamesWithHistory.makeAbsolute0 (Branch.toNames root0)
|
||||
absoluteRootNames = Names.makeAbsolute (Branch.toNames root0)
|
||||
currentBranch0 = Branch.head currentBranch
|
||||
currentPathNames = Branch.toNames currentBranch0
|
||||
-- all names, but with local names in their relative form only, rather
|
||||
-- than absolute; external names appear as absolute
|
||||
currentAndExternalNames =
|
||||
currentPathNames
|
||||
`NamesWithHistory.unionLeft0` absDot externalNames
|
||||
`Names.unionLeft` absDot externalNames
|
||||
where
|
||||
absDot = Names.prefix0 (Name.unsafeFromText "")
|
||||
externalNames = rootNames `Names.difference` pathPrefixed currentPathNames
|
||||
@ -458,7 +458,7 @@ getCurrentParseNames path root = NamesWithHistory (basicParseNames root path) me
|
||||
-- then name foo.bar.baz becomes baz
|
||||
-- name cat.dog becomes .cat.dog
|
||||
fixupNamesRelative :: Path.Absolute -> Names -> Names
|
||||
fixupNamesRelative root = NamesWithHistory.map0 fixName where
|
||||
fixupNamesRelative root = Names.map fixName where
|
||||
prefix = Path.toName $ Path.unabsolute root
|
||||
fixName n = if root == Path.absoluteEmpty
|
||||
then n
|
||||
|
||||
@ -38,7 +38,7 @@ import qualified Unison.ConstructorType as CT
|
||||
import qualified Unison.HashQualified as HQ
|
||||
import qualified Unison.Lexer as L
|
||||
import qualified Unison.Name as Name
|
||||
import qualified Unison.NamesWithHistory as Names
|
||||
import qualified Unison.Names as Names
|
||||
import qualified Unison.Parser as Parser (seq, uniqueName)
|
||||
import Unison.Parser.Ann (Ann)
|
||||
import qualified Unison.Pattern as Pattern
|
||||
@ -48,6 +48,7 @@ import qualified Unison.TypeParser as TypeParser
|
||||
import qualified Unison.Typechecker.Components as Components
|
||||
import qualified Unison.Util.Bytes as Bytes
|
||||
import qualified Unison.Var as Var
|
||||
import qualified Unison.NamesWithHistory as NamesWithHistory
|
||||
|
||||
watch :: Show a => String -> a -> a
|
||||
watch msg a = let !_ = trace (msg ++ ": " ++ show a) () in a
|
||||
@ -85,7 +86,7 @@ typeLink' :: Var v => P v (L.Token Reference)
|
||||
typeLink' = do
|
||||
id <- hqPrefixId
|
||||
ns <- asks names
|
||||
case Names.lookupHQType (L.payload id) ns of
|
||||
case NamesWithHistory.lookupHQType (L.payload id) ns of
|
||||
s | Set.size s == 1 -> pure $ const (Set.findMin s) <$> id
|
||||
| otherwise -> customFailure $ UnknownType id s
|
||||
|
||||
@ -93,7 +94,7 @@ termLink' :: Var v => P v (L.Token Referent)
|
||||
termLink' = do
|
||||
id <- hqPrefixId
|
||||
ns <- asks names
|
||||
case Names.lookupHQTerm (L.payload id) ns of
|
||||
case NamesWithHistory.lookupHQTerm (L.payload id) ns of
|
||||
s | Set.size s == 1 -> pure $ const (Set.findMin s) <$> id
|
||||
| otherwise -> customFailure $ UnknownTerm id s
|
||||
|
||||
@ -101,7 +102,7 @@ link' :: Var v => P v (Either (L.Token Reference) (L.Token Referent))
|
||||
link' = do
|
||||
id <- hqPrefixId
|
||||
ns <- asks names
|
||||
case (Names.lookupHQTerm (L.payload id) ns, Names.lookupHQType (L.payload id) ns) of
|
||||
case (NamesWithHistory.lookupHQTerm (L.payload id) ns, NamesWithHistory.lookupHQType (L.payload id) ns) of
|
||||
(s, s2) | Set.size s == 1 && Set.null s2 -> pure . Right $ const (Set.findMin s) <$> id
|
||||
(s, s2) | Set.size s2 == 1 && Set.null s -> pure . Left $ const (Set.findMin s2) <$> id
|
||||
(s, s2) -> customFailure $ UnknownId id s s2
|
||||
@ -222,7 +223,7 @@ parsePattern = root
|
||||
names <- asks names
|
||||
-- probably should avoid looking up in `names` if `L.payload tok`
|
||||
-- starts with a lowercase
|
||||
case Names.lookupHQPattern (L.payload tok) ct names of
|
||||
case NamesWithHistory.lookupHQPattern (L.payload tok) ct names of
|
||||
s | Set.null s -> die tok s
|
||||
| Set.size s > 1 -> die tok s
|
||||
| otherwise -> -- matched ctor name, consume the token
|
||||
@ -359,7 +360,7 @@ resolveHashQualified tok = do
|
||||
names <- asks names
|
||||
case L.payload tok of
|
||||
HQ.NameOnly n -> pure $ Term.var (ann tok) (Name.toVar n)
|
||||
_ -> case Names.lookupHQTerm (L.payload tok) names of
|
||||
_ -> case NamesWithHistory.lookupHQTerm (L.payload tok) names of
|
||||
s | Set.null s -> failCommitted $ UnknownTerm tok s
|
||||
| Set.size s > 1 -> failCommitted $ UnknownTerm tok s
|
||||
| otherwise -> pure $ Term.fromReferent (ann tok) (Set.findMin s)
|
||||
@ -975,7 +976,7 @@ importp = do
|
||||
(Just prefix@(Left _), _) -> P.customFailure $ UseInvalidPrefixSuffix prefix suffixes
|
||||
(Just (Right prefix), Nothing) -> do -- `wildcard import`
|
||||
names <- asks names
|
||||
pure $ Names.expandWildcardImport (L.payload prefix) (Names.currentNames names)
|
||||
pure $ Names.expandWildcardImport (L.payload prefix) (NamesWithHistory.currentNames names)
|
||||
(Just (Right prefix), Just suffixes) -> pure $ do
|
||||
suffix <- L.payload <$> suffixes
|
||||
pure (suffix, Name.joinDot (L.payload prefix) suffix)
|
||||
@ -997,7 +998,7 @@ imports :: Var v => P v (NamesWithHistory, [(v,v)])
|
||||
imports = do
|
||||
let sem = P.try (semi <* P.lookAhead (reserved "use"))
|
||||
imported <- mconcat . reverse <$> sepBy sem importp
|
||||
ns' <- Names.importing imported <$> asks names
|
||||
ns' <- NamesWithHistory.importing imported <$> asks names
|
||||
pure (ns', [(Name.toVar suffix, Name.toVar full) | (suffix,full) <- imported ])
|
||||
|
||||
-- A key feature of imports is we want to be able to say:
|
||||
@ -1009,7 +1010,7 @@ substImports ns imports =
|
||||
| (suffix,full) <- imports ] . -- no guard here, as `full` could be bound
|
||||
-- not in Names, but in a later term binding
|
||||
Term.substTypeVars [ (suffix, Type.var () full)
|
||||
| (suffix, full) <- imports, Names.hasTypeNamed (Name.fromVar full) ns ]
|
||||
| (suffix, full) <- imports, NamesWithHistory.hasTypeNamed (Name.fromVar full) ns ]
|
||||
|
||||
block' :: Var v => IsTop -> String -> P v (L.Token ()) -> P v b -> TermP v
|
||||
block' isTop = block'' isTop False
|
||||
|
||||
@ -15,8 +15,7 @@ import qualified Unison.DataDeclaration.Names as DD.Names
|
||||
import qualified Unison.Hashing.V2.Convert as Hashing
|
||||
import qualified Unison.Name as Name
|
||||
import qualified Unison.Names.ResolutionResult as Names
|
||||
import Unison.Names (Names)
|
||||
import qualified Unison.NamesWithHistory as Names
|
||||
import Unison.Names (Names (Names))
|
||||
import Unison.Prelude
|
||||
import qualified Unison.Reference as Reference
|
||||
import qualified Unison.Referent as Referent
|
||||
@ -36,7 +35,7 @@ toNames uf = datas <> effects
|
||||
effects = foldMap DD.Names.effectDeclToNames' (Map.toList (UF.effectDeclarationsId uf))
|
||||
|
||||
typecheckedToNames :: Var v => TypecheckedUnisonFile v a -> Names
|
||||
typecheckedToNames uf = Names.names0 (terms <> ctors) types where
|
||||
typecheckedToNames uf = Names (terms <> ctors) types where
|
||||
terms = Relation.fromList
|
||||
[ (Name.fromVar v, Referent.Ref r)
|
||||
| (v, (r, wk, _, _)) <- Map.toList $ UF.hashTerms uf, wk == Nothing || wk == Just WK.TestWatch ]
|
||||
|
||||
@ -21,8 +21,7 @@ import qualified Unison.Reference as Reference
|
||||
import qualified Unison.Referent as Referent
|
||||
import qualified Unison.Type.Names as Type.Names
|
||||
import Unison.Var ( Var )
|
||||
import Unison.Names (Names)
|
||||
import qualified Unison.NamesWithHistory as Names
|
||||
import Unison.Names (Names (Names))
|
||||
import qualified Unison.Names.ResolutionResult as Names
|
||||
import qualified Unison.ConstructorType as CT
|
||||
|
||||
@ -32,10 +31,10 @@ toNames ct typeSymbol (Reference.DerivedId -> r) dd =
|
||||
-- constructor names
|
||||
foldMap names (DD.constructorVars dd `zip` [0 ..])
|
||||
-- name of the type itself
|
||||
<> Names.names0 mempty (Rel.singleton (Name.fromVar typeSymbol) r)
|
||||
<> Names mempty (Rel.singleton (Name.fromVar typeSymbol) r)
|
||||
where
|
||||
names (ctor, i) =
|
||||
Names.names0 (Rel.singleton (Name.fromVar ctor) (Referent.Con r i ct)) mempty
|
||||
Names (Rel.singleton (Name.fromVar ctor) (Referent.Con r i ct)) mempty
|
||||
|
||||
dataDeclToNames :: Var v => v -> Reference.Id -> DataDeclaration v a -> Names
|
||||
dataDeclToNames = toNames CT.Data
|
||||
|
||||
@ -16,6 +16,8 @@ module Unison.Names
|
||||
, filterByHQs
|
||||
, filterBySHs
|
||||
, filterTypes
|
||||
, map
|
||||
, makeAbsolute
|
||||
, fuzzyFind
|
||||
, hqName
|
||||
, hqTermName
|
||||
@ -38,6 +40,11 @@ module Unison.Names
|
||||
, unionLeftName
|
||||
, namesForReference
|
||||
, namesForReferent
|
||||
, shadowTerms
|
||||
, importing
|
||||
, constructorsForType
|
||||
, expandWildcardImport
|
||||
, isEmpty
|
||||
)
|
||||
where
|
||||
|
||||
@ -46,7 +53,7 @@ import Unison.Prelude
|
||||
import qualified Data.Map as Map
|
||||
import qualified Data.Set as Set
|
||||
import qualified Data.Text as Text
|
||||
import Prelude hiding (filter)
|
||||
import Prelude hiding (filter, map)
|
||||
import qualified Prelude
|
||||
import Unison.HashQualified' (HashQualified)
|
||||
import qualified Unison.HashQualified' as HQ
|
||||
@ -61,16 +68,40 @@ import qualified Unison.Util.Relation as R
|
||||
import qualified Unison.ShortHash as SH
|
||||
import Unison.ShortHash (ShortHash)
|
||||
import qualified Text.FuzzyFind as FZF
|
||||
import qualified Unison.ConstructorType as CT
|
||||
|
||||
-- This will support the APIs of both PrettyPrintEnv and the old Names.
|
||||
-- For pretty-printing, we need to look up names for References; they may have
|
||||
-- some hash-qualification, depending on the context.
|
||||
-- For pretty-printing, we need to look up names for References.
|
||||
-- For parsing (both .u files and command-line args)
|
||||
data Names = Names
|
||||
{ terms :: Relation Name Referent
|
||||
, types :: Relation Name Reference
|
||||
} deriving (Eq,Ord)
|
||||
|
||||
instance Semigroup (Names) where (<>) = mappend
|
||||
|
||||
instance Monoid (Names) where
|
||||
mempty = Names mempty mempty
|
||||
Names e1 t1 `mappend` Names e2 t2 =
|
||||
Names (e1 <> e2) (t1 <> t2)
|
||||
|
||||
instance Show (Names) where
|
||||
show (Names terms types) = "Terms:\n" ++
|
||||
foldMap (\(n, r) -> " " ++ show n ++ " -> " ++ show r ++ "\n") (R.toList terms) ++ "\n" ++
|
||||
"Types:\n" ++
|
||||
foldMap (\(n, r) -> " " ++ show n ++ " -> " ++ show r ++ "\n") (R.toList types) ++ "\n"
|
||||
|
||||
isEmpty :: Names -> Bool
|
||||
isEmpty n = R.null (terms n) && R.null (types n)
|
||||
|
||||
map :: (Name -> Name) -> Names -> Names
|
||||
map f (Names {terms, types}) = Names terms' types' where
|
||||
terms' = R.mapDom f terms
|
||||
types' = R.mapDom f types
|
||||
|
||||
makeAbsolute :: Names -> Names
|
||||
makeAbsolute = map Name.makeAbsolute
|
||||
|
||||
-- Finds names that are supersequences of all the given strings, ordered by
|
||||
-- score and grouped by name.
|
||||
fuzzyFind
|
||||
@ -341,16 +372,62 @@ contains names r =
|
||||
conflicts :: Names -> Names
|
||||
conflicts Names{..} = Names (R.filterManyDom terms) (R.filterManyDom types)
|
||||
|
||||
instance Semigroup (Names) where (<>) = mappend
|
||||
-- Deletes from the `n0 : Names` any definitions whose names
|
||||
-- are in `ns`. Does so using logarithmic time lookups,
|
||||
-- traversing only `ns`.
|
||||
--
|
||||
-- See usage in `FileParser` for handling precendence of symbol
|
||||
-- resolution where local names are preferred to codebase names.
|
||||
shadowTerms :: [Name] -> Names -> Names
|
||||
shadowTerms ns n0 = Names terms' (types n0)
|
||||
where
|
||||
terms' = foldl' go (terms n0) ns
|
||||
go ts name = R.deleteDom name ts
|
||||
|
||||
instance Monoid (Names) where
|
||||
mempty = Names mempty mempty
|
||||
Names e1 t1 `mappend` Names e2 t2 =
|
||||
Names (e1 <> e2) (t1 <> t2)
|
||||
-- | Given a mapping from name to qualified name, update a `Names`,
|
||||
-- so for instance if the input has [(Some, Optional.Some)],
|
||||
-- and `Optional.Some` is a constructor in the input `Names`,
|
||||
-- the alias `Some` will map to that same constructor and shadow
|
||||
-- anything else that is currently called `Some`.
|
||||
importing :: [(Name, Name)] -> Names -> Names
|
||||
importing shortToLongName ns =
|
||||
Names
|
||||
(foldl' go (terms ns) shortToLongName)
|
||||
(foldl' go (types ns) shortToLongName)
|
||||
where
|
||||
go :: (Ord r) => Relation Name r -> (Name, Name) -> Relation Name r
|
||||
go m (shortname, qname) = case Name.searchBySuffix qname m of
|
||||
s | Set.null s -> m
|
||||
| otherwise -> R.insertManyRan shortname s (R.deleteDom shortname m)
|
||||
|
||||
instance Show (Names) where
|
||||
show (Names terms types) = "Terms:\n" ++
|
||||
foldMap (\(n, r) -> " " ++ show n ++ " -> " ++ show r ++ "\n") (R.toList terms) ++ "\n" ++
|
||||
"Types:\n" ++
|
||||
foldMap (\(n, r) -> " " ++ show n ++ " -> " ++ show r ++ "\n") (R.toList types) ++ "\n"
|
||||
-- | Converts a wildcard import into a list of explicit imports, of the form
|
||||
-- [(suffix, full)]. Example: if `io` contains two functions, `foo` and
|
||||
-- `bar`, then `expandWildcardImport io` will produce
|
||||
-- `[(foo, io.foo), (bar, io.bar)]`.
|
||||
expandWildcardImport :: Name -> Names -> [(Name,Name)]
|
||||
expandWildcardImport prefix ns =
|
||||
[ (suffix, full) | Just (suffix,full) <- go <$> R.toList (terms ns) ] <>
|
||||
[ (suffix, full) | Just (suffix,full) <- go <$> R.toList (types ns) ]
|
||||
where
|
||||
go (full, _) = do
|
||||
-- running example:
|
||||
-- prefix = Int
|
||||
-- full = builtin.Int.negate
|
||||
rem <- Name.suffixFrom prefix full
|
||||
-- rem = Int.negate
|
||||
suffix <- Name.stripNamePrefix prefix rem
|
||||
-- suffix = negate
|
||||
pure (suffix, full)
|
||||
|
||||
-- Finds all the constructors for the given type in the `Names`
|
||||
constructorsForType :: Reference -> Names -> [(Name,Referent)]
|
||||
constructorsForType r ns = let
|
||||
-- rather than searching all of names, we use the known possible forms
|
||||
-- that the constructors can take
|
||||
possibleDatas = [ Referent.Con r cid CT.Data | cid <- [0..] ]
|
||||
possibleEffects = [ Referent.Con r cid CT.Effect | cid <- [0..] ]
|
||||
trim [] = []
|
||||
trim (h:t) = case R.lookupRan h (terms ns) of
|
||||
s | Set.null s -> []
|
||||
| otherwise -> [ (n,h) | n <- toList s ] ++ trim t
|
||||
in trim possibleEffects ++ trim possibleDatas
|
||||
|
||||
@ -23,6 +23,10 @@ import qualified Unison.Util.Relation as R
|
||||
import qualified Unison.ConstructorType as CT
|
||||
import Unison.Names (Names(..) )
|
||||
|
||||
-- | NamesWithHistory contains two sets of 'Names',
|
||||
-- One represents names which are currently assigned,
|
||||
-- the other represents names which no longer apply, perhaps they've been deleted, or the term
|
||||
-- was updated and the name points elsewhere now.
|
||||
data NamesWithHistory = NamesWithHistory
|
||||
{ -- | currentNames represent references which are named in the current version of the namespace.
|
||||
currentNames :: Names.Names,
|
||||
@ -41,12 +45,12 @@ filterTypes = Names.filterTypes
|
||||
--
|
||||
-- `addedNames` are names in `n2` but not `n1`
|
||||
-- `removedNames` are names in `n1` but not `n2`
|
||||
diff0 :: Names -> Names -> Diff
|
||||
diff0 n1 n2 = Diff n1 added removed where
|
||||
added = Names (terms0 n2 `R.difference` terms0 n1)
|
||||
(types0 n2 `R.difference` types0 n1)
|
||||
removed = Names (terms0 n1 `R.difference` terms0 n2)
|
||||
(types0 n1 `R.difference` types0 n2)
|
||||
diff :: Names -> Names -> Diff
|
||||
diff n1 n2 = Diff n1 added removed where
|
||||
added = Names (terms n2 `R.difference` terms n1)
|
||||
(types n2 `R.difference` types n1)
|
||||
removed = Names (terms n1 `R.difference` terms n2)
|
||||
(types n1 `R.difference` types n2)
|
||||
|
||||
data Diff =
|
||||
Diff { originalNames :: Names
|
||||
@ -54,12 +58,6 @@ data Diff =
|
||||
, removedNames :: Names
|
||||
} deriving Show
|
||||
|
||||
isEmptyDiff :: Diff -> Bool
|
||||
isEmptyDiff d = isEmpty0 (addedNames d) && isEmpty0 (removedNames d)
|
||||
|
||||
isEmpty0 :: Names -> Bool
|
||||
isEmpty0 n = R.null (terms0 n) && R.null (types0 n)
|
||||
|
||||
-- Add `n1` to `currentNames`, shadowing anything with the same name and
|
||||
-- moving shadowed definitions into `oldNames` so they can can still be
|
||||
-- referenced hash qualified.
|
||||
@ -67,13 +65,13 @@ push :: Names -> NamesWithHistory -> NamesWithHistory
|
||||
push n0 ns = NamesWithHistory (unionLeft0 n1 cur) (oldNames ns <> shadowed) where
|
||||
n1 = suffixify0 n0
|
||||
cur = currentNames ns
|
||||
shadowed = names0 terms' types' where
|
||||
terms' = R.dom (terms0 n1) R.<| (terms0 cur `R.difference` terms0 n1)
|
||||
types' = R.dom (types0 n1) R.<| (types0 cur `R.difference` types0 n1)
|
||||
shadowed = Names terms' types' where
|
||||
terms' = R.dom (terms n1) R.<| (terms cur `R.difference` terms n1)
|
||||
types' = R.dom (types n1) R.<| (types cur `R.difference` types n1)
|
||||
unionLeft0 :: Names -> Names -> Names
|
||||
unionLeft0 n1 n2 = names0 terms' types' where
|
||||
terms' = terms0 n1 <> R.subtractDom (R.dom $ terms0 n1) (terms0 n2)
|
||||
types' = types0 n1 <> R.subtractDom (R.dom $ types0 n1) (types0 n2)
|
||||
unionLeft0 n1 n2 = Names terms' types' where
|
||||
terms' = terms n1 <> R.subtractDom (R.dom $ terms n1) (terms n2)
|
||||
types' = types n1 <> R.subtractDom (R.dom $ types n1) (types n2)
|
||||
-- For all names in `ns`, (ex: foo.bar.baz), generate the list of suffixes
|
||||
-- of that name [[foo.bar.baz], [bar.baz], [baz]]. Any suffix which uniquely
|
||||
-- refers to a single definition is added as an alias
|
||||
@ -88,41 +86,18 @@ push n0 ns = NamesWithHistory (unionLeft0 n1 cur) (oldNames ns <> shadowed) wher
|
||||
suffixify0 :: Names -> Names
|
||||
suffixify0 ns = ns <> suffixNs
|
||||
where
|
||||
suffixNs = names0 (R.fromList uniqueTerms) (R.fromList uniqueTypes)
|
||||
terms = List.multimap [ (n,ref) | (n0,ref) <- R.toList (terms0 ns), n <- Name.suffixes n0 ]
|
||||
types = List.multimap [ (n,ref) | (n0,ref) <- R.toList (types0 ns), n <- Name.suffixes n0 ]
|
||||
uniqueTerms = [ (n,ref) | (n, nubOrd -> [ref]) <- Map.toList terms ]
|
||||
uniqueTypes = [ (n,ref) | (n, nubOrd -> [ref]) <- Map.toList types ]
|
||||
|
||||
unionLeft0 :: Names -> Names -> Names
|
||||
unionLeft0 = Names.unionLeft
|
||||
|
||||
unionLeftName0 :: Names -> Names -> Names
|
||||
unionLeftName0 = Names.unionLeftName
|
||||
|
||||
map0 :: (Name -> Name) -> Names -> Names
|
||||
map0 f (Names.Names terms types) = Names.Names terms' types' where
|
||||
terms' = R.mapDom f terms
|
||||
types' = R.mapDom f types
|
||||
|
||||
names0 :: Relation Name Referent -> Relation Name Reference -> Names
|
||||
names0 = Names.Names
|
||||
|
||||
types0 :: Names -> Relation Name Reference
|
||||
types0 = Names.types
|
||||
|
||||
terms0 :: Names -> Relation Name Referent
|
||||
terms0 = Names.terms
|
||||
suffixNs = Names (R.fromList uniqueTerms) (R.fromList uniqueTypes)
|
||||
terms' = List.multimap [ (n,ref) | (n0,ref) <- R.toList (terms ns), n <- Name.suffixes n0 ]
|
||||
types' = List.multimap [ (n,ref) | (n0,ref) <- R.toList (types ns), n <- Name.suffixes n0 ]
|
||||
uniqueTerms = [ (n,ref) | (n, nubOrd -> [ref]) <- Map.toList terms' ]
|
||||
uniqueTypes = [ (n,ref) | (n, nubOrd -> [ref]) <- Map.toList types' ]
|
||||
|
||||
-- if I push an existing name, the pushed reference should be the thing
|
||||
-- if I push a different name for the same thing, i suppose they should coexist
|
||||
-- thus, `unionLeftName0`.
|
||||
-- thus, `unionLeftName`.
|
||||
shadowing :: Names -> NamesWithHistory -> NamesWithHistory
|
||||
shadowing prio (NamesWithHistory current old) =
|
||||
NamesWithHistory (prio `unionLeftName0` current) (current <> old)
|
||||
|
||||
makeAbsolute0 :: Names -> Names
|
||||
makeAbsolute0 = map0 Name.makeAbsolute
|
||||
NamesWithHistory (prio `Names.unionLeft` current) (current <> old)
|
||||
|
||||
-- Find all types whose name has a suffix matching the provided `HashQualified`,
|
||||
-- returning types with relative names if they exist, and otherwise
|
||||
@ -295,20 +270,7 @@ lookupHQPattern hq ctt names = Set.fromList
|
||||
, ct == ctt
|
||||
]
|
||||
|
||||
-- Finds all the constructors for the given type in the `Names`
|
||||
constructorsForType0 :: Reference -> Names -> [(Name,Referent)]
|
||||
constructorsForType0 r ns = let
|
||||
-- rather than searching all of names, we use the known possible forms
|
||||
-- that the constructors can take
|
||||
possibleDatas = [ Referent.Con r cid CT.Data | cid <- [0..] ]
|
||||
possibleEffects = [ Referent.Con r cid CT.Effect | cid <- [0..] ]
|
||||
trim [] = []
|
||||
trim (h:t) = case R.lookupRan h (terms0 ns) of
|
||||
s | Set.null s -> []
|
||||
| otherwise -> [ (n,h) | n <- toList s ] ++ trim t
|
||||
in trim possibleEffects ++ trim possibleDatas
|
||||
|
||||
-- Given a mapping from name to qualified name, update a `Names`,
|
||||
-- | Given a mapping from name to qualified name, update a `Names`,
|
||||
-- so for instance if the input has [(Some, Optional.Some)],
|
||||
-- and `Optional.Some` is a constructor in the input `Names`,
|
||||
-- the alias `Some` will map to that same constructor and shadow
|
||||
@ -317,46 +279,4 @@ constructorsForType0 r ns = let
|
||||
-- Only affects `currentNames`.
|
||||
importing :: [(Name, Name)] -> NamesWithHistory -> NamesWithHistory
|
||||
importing shortToLongName ns =
|
||||
ns { currentNames = importing0 shortToLongName (currentNames ns) }
|
||||
|
||||
importing0 :: [(Name, Name)] -> Names -> Names
|
||||
importing0 shortToLongName ns =
|
||||
Names.Names
|
||||
(foldl' go (terms0 ns) shortToLongName)
|
||||
(foldl' go (types0 ns) shortToLongName)
|
||||
where
|
||||
go :: (Ord r) => Relation Name r -> (Name, Name) -> Relation Name r
|
||||
go m (shortname, qname) = case Name.searchBySuffix qname m of
|
||||
s | Set.null s -> m
|
||||
| otherwise -> R.insertManyRan shortname s (R.deleteDom shortname m)
|
||||
|
||||
-- Converts a wildcard import into a list of explicit imports, of the form
|
||||
-- [(suffix, full)]. Example: if `io` contains two functions, `foo` and
|
||||
-- `bar`, then `expandWildcardImport io` will produce
|
||||
-- `[(foo, io.foo), (bar, io.bar)]`.
|
||||
expandWildcardImport :: Name -> Names -> [(Name,Name)]
|
||||
expandWildcardImport prefix ns =
|
||||
[ (suffix, full) | Just (suffix,full) <- go <$> R.toList (terms0 ns) ] <>
|
||||
[ (suffix, full) | Just (suffix,full) <- go <$> R.toList (types0 ns) ]
|
||||
where
|
||||
go (full, _) = do
|
||||
-- running example:
|
||||
-- prefix = Int
|
||||
-- full = builtin.Int.negate
|
||||
rem <- Name.suffixFrom prefix full
|
||||
-- rem = Int.negate
|
||||
suffix <- Name.stripNamePrefix prefix rem
|
||||
-- suffix = negate
|
||||
pure (suffix, full)
|
||||
|
||||
-- Deletes from the `n0 : Names` any definitions whose names
|
||||
-- are in `ns`. Does so using logarithmic time lookups,
|
||||
-- traversing only `ns`.
|
||||
--
|
||||
-- See usage in `FileParser` for handling precendence of symbol
|
||||
-- resolution where local names are preferred to codebase names.
|
||||
shadowTerms0 :: [Name] -> Names -> Names
|
||||
shadowTerms0 ns n0 = names0 terms' (types0 n0)
|
||||
where
|
||||
terms' = foldl' go (terms0 n0) ns
|
||||
go ts name = R.deleteDom name ts
|
||||
ns { currentNames = Names.importing shortToLongName (currentNames ns) }
|
||||
|
||||
@ -25,6 +25,7 @@ import Text.Show
|
||||
import qualified Unison.ABT as ABT
|
||||
import qualified Unison.Blank as B
|
||||
import Unison.Names ( Names )
|
||||
import qualified Unison.Names as Names
|
||||
import qualified Unison.NamesWithHistory as Names
|
||||
import qualified Unison.Names.ResolutionResult as Names
|
||||
import Unison.Pattern (Pattern)
|
||||
@ -169,7 +170,7 @@ bindSomeNames avoid ns e = bindNames (avoid <> varsToTDNR) ns e where
|
||||
-- (if a free variable is being used as a typed hole).
|
||||
varsToTDNR = Set.filter notFound (freeVars e)
|
||||
notFound var =
|
||||
Set.size (Name.searchBySuffix (Name.fromVar var) (Names.terms0 ns)) /= 1
|
||||
Set.size (Name.searchBySuffix (Name.fromVar var) (Names.terms ns)) /= 1
|
||||
|
||||
-- Prepare a term for type-directed name resolution by replacing
|
||||
-- any remaining free variables with blanks to be resolved by TDNR
|
||||
|
||||
Loading…
Reference in New Issue
Block a user