mirror of
https://github.com/unisonweb/unison.git
synced 2024-11-10 20:00:27 +03:00
Names3 -> NamesWithHistory; Names2 -> Names
This commit is contained in:
Chris Penner
parent
fdf7932f3b
commit
9d4dbafd16
@ -42,7 +42,7 @@ import Unison.Var ( Var )
|
||||
import qualified Unison.Var as Var
|
||||
import Unison.Name ( Name )
|
||||
import qualified Unison.Name as Name
|
||||
import Unison.Names3 (Names(Names), Names0)
|
||||
import Unison.Names3 (NamesWithHistory(..), Names0)
|
||||
import qualified Unison.Names3 as Names3
|
||||
import qualified Unison.Typechecker.TypeLookup as TL
|
||||
import qualified Unison.Util.Relation as Rel
|
||||
@ -52,8 +52,8 @@ type DataDeclaration v = DD.DataDeclaration v Ann
|
||||
type EffectDeclaration v = DD.EffectDeclaration v Ann
|
||||
type Type v = Type.Type v ()
|
||||
|
||||
names :: Names
|
||||
names = Names names0 mempty
|
||||
names :: NamesWithHistory
|
||||
names = NamesWithHistory names0 mempty
|
||||
|
||||
names0 :: Names0
|
||||
names0 = Names3.names0 terms types where
|
||||
|
||||
@ -34,7 +34,7 @@ import qualified Unison.Codebase.Branch as Branch
|
||||
import qualified Unison.Codebase.Branch.Merge as Branch
|
||||
import qualified Unison.Codebase.Reflog as Reflog
|
||||
import Unison.Codebase.SyncMode ( SyncMode )
|
||||
import Unison.Names3 ( Names, Names0 )
|
||||
import Unison.Names3 ( NamesWithHistory, Names0 )
|
||||
import Unison.Parser.Ann (Ann)
|
||||
import Unison.Referent ( Referent )
|
||||
import Unison.Reference ( Reference )
|
||||
@ -124,13 +124,13 @@ data Command m i v a where
|
||||
|
||||
BranchHashesByPrefix :: ShortBranchHash -> Command m i v (Set Branch.Hash)
|
||||
|
||||
ParseType :: Names -> LexedSource
|
||||
ParseType :: NamesWithHistory -> LexedSource
|
||||
-> Command m i v (Either (Parser.Err v) (Type v Ann))
|
||||
|
||||
LoadSource :: SourceName -> Command m i v LoadSourceResult
|
||||
|
||||
Typecheck :: AmbientAbilities v
|
||||
-> Names
|
||||
-> NamesWithHistory
|
||||
-> SourceName
|
||||
-> LexedSource
|
||||
-> Command m i v (TypecheckingResult v)
|
||||
|
||||
@ -85,7 +85,7 @@ import qualified Unison.HashQualified as HQ
|
||||
import qualified Unison.HashQualified' as HQ'
|
||||
import qualified Unison.Name as Name
|
||||
import Unison.Name ( Name )
|
||||
import Unison.Names3 ( Names(..), Names0
|
||||
import Unison.Names3 ( NamesWithHistory(..), Names0
|
||||
, pattern Names0 )
|
||||
import qualified Unison.Names2 as Names
|
||||
import qualified Unison.Names3 as Names3
|
||||
@ -200,7 +200,7 @@ type Action' m v = Action m (Either Event Input) v
|
||||
defaultPatchNameSegment :: NameSegment
|
||||
defaultPatchNameSegment = "patch"
|
||||
|
||||
prettyPrintEnvDecl :: Names -> Action' m v PPE.PrettyPrintEnvDecl
|
||||
prettyPrintEnvDecl :: NamesWithHistory -> Action' m v PPE.PrettyPrintEnvDecl
|
||||
prettyPrintEnvDecl ns = eval CodebaseHashLength <&> (`PPE.fromNamesDecl` ns)
|
||||
|
||||
loop :: forall m v . (Monad m, Var v) => Action m (Either Event Input) v ()
|
||||
@ -637,7 +637,7 @@ loop = do
|
||||
uf <- use latestTypecheckedFile >>= addWatch (HQ.toString hq)
|
||||
case uf of
|
||||
Nothing -> do
|
||||
let parseNames0 = (`Names3.Names` mempty) basicPrettyPrintNames0
|
||||
let parseNames0 = (`Names3.NamesWithHistory` mempty) basicPrettyPrintNames0
|
||||
results = Names3.lookupHQTerm hq parseNames0
|
||||
if Set.null results then
|
||||
respond $ SearchTermsNotFound [hq]
|
||||
@ -1015,10 +1015,10 @@ loop = do
|
||||
|
||||
NamesI thing -> do
|
||||
ns0 <- basicParseNames0
|
||||
let ns = Names ns0 mempty
|
||||
let ns = NamesWithHistory ns0 mempty
|
||||
terms = Names3.lookupHQTerm thing ns
|
||||
types = Names3.lookupHQType thing ns
|
||||
printNames = Names basicPrettyPrintNames0 mempty
|
||||
printNames = NamesWithHistory basicPrettyPrintNames0 mempty
|
||||
terms' :: Set (Referent, Set (HQ'.HashQualified Name))
|
||||
terms' = Set.map go terms where
|
||||
go r = (r, Names3.termName hqLength r printNames)
|
||||
@ -1061,7 +1061,7 @@ loop = do
|
||||
|
||||
fileByName = do
|
||||
ns <- maybe mempty UF.typecheckedToNames0 <$> use latestTypecheckedFile
|
||||
fnames <- pure $ Names3.Names ns mempty
|
||||
fnames <- pure $ Names3.NamesWithHistory ns mempty
|
||||
case Names3.lookupHQTerm dotDoc fnames of
|
||||
s | Set.size s == 1 -> do
|
||||
-- the displayI command expects full term names, so we resolve
|
||||
@ -1076,7 +1076,7 @@ loop = do
|
||||
[] -> codebaseByName
|
||||
[(_name, ref, _tm)] -> do
|
||||
len <- eval BranchHashLength
|
||||
let names = Names3.Names basicPrettyPrintNames0 mempty
|
||||
let names = Names3.NamesWithHistory basicPrettyPrintNames0 mempty
|
||||
let tm = Term.ref External ref
|
||||
tm <- eval $ Evaluate1 (PPE.fromNames len names) True tm
|
||||
case tm of
|
||||
@ -1088,7 +1088,7 @@ loop = do
|
||||
|
||||
codebaseByName = do
|
||||
parseNames <- basicParseNames0
|
||||
case Names3.lookupHQTerm dotDoc (Names3.Names parseNames mempty) of
|
||||
case Names3.lookupHQTerm dotDoc (Names3.NamesWithHistory parseNames mempty) of
|
||||
s | Set.size s == 1 -> displayI ConsoleLocation dotDoc
|
||||
| Set.size s == 0 -> respond $ ListOfLinks mempty []
|
||||
| otherwise -> -- todo: return a list of links here too
|
||||
@ -1580,11 +1580,11 @@ loop = do
|
||||
|
||||
ExecuteI main -> addRunMain main uf >>= \case
|
||||
NoTermWithThatName -> do
|
||||
ppe <- suffixifiedPPE (Names3.Names basicPrettyPrintNames0 mempty)
|
||||
ppe <- suffixifiedPPE (Names3.NamesWithHistory basicPrettyPrintNames0 mempty)
|
||||
mainType <- eval RuntimeMain
|
||||
respond $ NoMainFunction main ppe [mainType]
|
||||
TermHasBadType ty -> do
|
||||
ppe <- suffixifiedPPE (Names3.Names basicPrettyPrintNames0 mempty)
|
||||
ppe <- suffixifiedPPE (Names3.NamesWithHistory basicPrettyPrintNames0 mempty)
|
||||
mainType <- eval RuntimeMain
|
||||
respond $ BadMainFunction main ty ppe [mainType]
|
||||
RunMainSuccess unisonFile -> do
|
||||
@ -1598,7 +1598,7 @@ loop = do
|
||||
MakeStandaloneI output main -> do
|
||||
mainType <- eval RuntimeMain
|
||||
parseNames <-
|
||||
flip Names3.Names mempty <$> basicPrettyPrintNames0A
|
||||
flip Names3.NamesWithHistory mempty <$> basicPrettyPrintNames0A
|
||||
ppe <- suffixifiedPPE parseNames
|
||||
let resolved = toList $ Names3.lookupHQTerm main parseNames
|
||||
smain = HQ.toString main
|
||||
@ -1617,7 +1617,7 @@ loop = do
|
||||
IOTestI main -> do
|
||||
-- todo - allow this to run tests from scratch file, using addRunMain
|
||||
testType <- eval RuntimeTest
|
||||
parseNames <- (`Names3.Names` mempty) <$> basicPrettyPrintNames0A
|
||||
parseNames <- (`Names3.NamesWithHistory` mempty) <$> basicPrettyPrintNames0A
|
||||
ppe <- suffixifiedPPE parseNames
|
||||
-- use suffixed names for resolving the argument to display
|
||||
let
|
||||
@ -1898,7 +1898,7 @@ resolveHQToLabeledDependencies = \case
|
||||
types <- eval $ TypeReferencesByShortHash sh
|
||||
pure $ Set.map LD.referent terms <> Set.map LD.typeRef types
|
||||
|
||||
doDisplay :: Var v => OutputLocation -> Names -> Term v () -> Action' m v ()
|
||||
doDisplay :: Var v => OutputLocation -> NamesWithHistory -> Term v () -> Action' m v ()
|
||||
doDisplay outputLoc names tm = do
|
||||
ppe <- prettyPrintEnvDecl names
|
||||
tf <- use latestTypecheckedFile
|
||||
@ -2738,12 +2738,12 @@ fixupNamesRelative currentPath' = Names3.map0 fixName where
|
||||
fromMaybe (Name.makeAbsolute n) (Name.stripNamePrefix prefix n)
|
||||
|
||||
makeHistoricalParsingNames ::
|
||||
Monad m => Set (HQ.HashQualified Name) -> Action' m v Names
|
||||
Monad m => Set (HQ.HashQualified Name) -> Action' m v NamesWithHistory
|
||||
makeHistoricalParsingNames lexedHQs = do
|
||||
rawHistoricalNames <- findHistoricalHQs lexedHQs
|
||||
basicNames0 <- basicParseNames0
|
||||
currentPath <- use currentPath
|
||||
pure $ Names basicNames0
|
||||
pure $ NamesWithHistory basicNames0
|
||||
(Names3.makeAbsolute0 rawHistoricalNames <>
|
||||
fixupNamesRelative currentPath rawHistoricalNames)
|
||||
|
||||
@ -2755,7 +2755,7 @@ loadTypeDisplayObject = \case
|
||||
maybe (MissingObject $ Reference.idToShortHash id) UserObject
|
||||
<$> eval (LoadType id)
|
||||
|
||||
lexedSource :: Monad m => SourceName -> Source -> Action' m v (Names, LexedSource)
|
||||
lexedSource :: Monad m => SourceName -> Source -> Action' m v (NamesWithHistory, LexedSource)
|
||||
lexedSource name src = do
|
||||
let tokens = L.lexer (Text.unpack name) (Text.unpack src)
|
||||
getHQ = \case
|
||||
@ -2768,10 +2768,10 @@ lexedSource name src = do
|
||||
parseNames <- makeHistoricalParsingNames hqs
|
||||
pure (parseNames, (src, tokens))
|
||||
|
||||
suffixifiedPPE :: Names -> Action' m v PPE.PrettyPrintEnv
|
||||
suffixifiedPPE :: NamesWithHistory -> Action' m v PPE.PrettyPrintEnv
|
||||
suffixifiedPPE ns = eval CodebaseHashLength <&> (`PPE.fromSuffixNames` ns)
|
||||
|
||||
fqnPPE :: Names -> Action' m v PPE.PrettyPrintEnv
|
||||
fqnPPE :: NamesWithHistory -> Action' m v PPE.PrettyPrintEnv
|
||||
fqnPPE ns = eval CodebaseHashLength <&> (`PPE.fromNames` ns)
|
||||
|
||||
parseSearchType :: (Monad m, Var v)
|
||||
@ -2785,7 +2785,7 @@ parseType input src = do
|
||||
(names0, lexed) <- lexedSource (Text.pack $ show input) (Text.pack src)
|
||||
parseNames <- basicParseNames0
|
||||
let names = Names3.push (Names3.currentNames names0)
|
||||
(Names3.Names parseNames (Names3.oldNames names0))
|
||||
(Names3.NamesWithHistory parseNames (Names3.oldNames names0))
|
||||
e <- eval $ ParseType names lexed
|
||||
pure $ case e of
|
||||
Left err -> Left $ TypeParseError src err
|
||||
@ -2795,12 +2795,12 @@ parseType input src = do
|
||||
Right typ -> Right typ
|
||||
|
||||
makeShadowedPrintNamesFromLabeled
|
||||
:: Monad m => Set LabeledDependency -> Names0 -> Action' m v Names
|
||||
:: Monad m => Set LabeledDependency -> Names0 -> Action' m v NamesWithHistory
|
||||
makeShadowedPrintNamesFromLabeled deps shadowing =
|
||||
Names3.shadowing shadowing <$> makePrintNamesFromLabeled' deps
|
||||
|
||||
makePrintNamesFromLabeled'
|
||||
:: Monad m => Set LabeledDependency -> Action' m v Names
|
||||
:: Monad m => Set LabeledDependency -> Action' m v NamesWithHistory
|
||||
makePrintNamesFromLabeled' deps = do
|
||||
root <- use root
|
||||
currentPath <- use currentPath
|
||||
@ -2808,7 +2808,7 @@ makePrintNamesFromLabeled' deps = do
|
||||
deps
|
||||
root
|
||||
basicNames0 <- basicPrettyPrintNames0A
|
||||
pure $ Names basicNames0 (fixupNamesRelative currentPath rawHistoricalNames)
|
||||
pure $ NamesWithHistory basicNames0 (fixupNamesRelative currentPath rawHistoricalNames)
|
||||
|
||||
getTermsIncludingHistorical
|
||||
:: Monad m => Path.HQSplit -> Branch0 m -> Action' m v (Set Referent)
|
||||
@ -2849,7 +2849,7 @@ findHistoricalHQs lexedHQs0 = do
|
||||
basicPrettyPrintNames0A :: Functor m => Action' m v Names0
|
||||
basicPrettyPrintNames0A = snd <$> basicNames0'
|
||||
|
||||
makeShadowedPrintNamesFromHQ :: Monad m => Set (HQ.HashQualified Name) -> Names0 -> Action' m v Names
|
||||
makeShadowedPrintNamesFromHQ :: Monad m => Set (HQ.HashQualified Name) -> Names0 -> Action' m v NamesWithHistory
|
||||
makeShadowedPrintNamesFromHQ lexedHQs shadowing = do
|
||||
rawHistoricalNames <- findHistoricalHQs lexedHQs
|
||||
basicNames0 <- basicPrettyPrintNames0A
|
||||
@ -2859,7 +2859,7 @@ makeShadowedPrintNamesFromHQ lexedHQs shadowing = do
|
||||
pure $
|
||||
Names3.shadowing
|
||||
shadowing
|
||||
(Names basicNames0 (fixupNamesRelative currentPath rawHistoricalNames))
|
||||
(NamesWithHistory basicNames0 (fixupNamesRelative currentPath rawHistoricalNames))
|
||||
|
||||
basicParseNames0, slurpResultNames0 :: Functor m => Action' m v Names0
|
||||
basicParseNames0 = fst <$> basicNames0'
|
||||
@ -2962,7 +2962,7 @@ executePPE unisonFile =
|
||||
-- Produce a `Names` needed to display all the hashes used in the given file.
|
||||
displayNames :: (Var v, Monad m)
|
||||
=> TypecheckedUnisonFile v a
|
||||
-> Action' m v Names
|
||||
-> Action' m v NamesWithHistory
|
||||
displayNames unisonFile =
|
||||
-- voodoo
|
||||
makeShadowedPrintNamesFromLabeled
|
||||
@ -2977,7 +2977,7 @@ diffHelper before after = do
|
||||
hqLength <- eval CodebaseHashLength
|
||||
diff <- eval . Eval $ BranchDiff.diff0 before after
|
||||
names0 <- basicPrettyPrintNames0A
|
||||
ppe <- PPE.suffixifiedPPE <$> prettyPrintEnvDecl (Names names0 mempty)
|
||||
ppe <- PPE.suffixifiedPPE <$> prettyPrintEnvDecl (NamesWithHistory names0 mempty)
|
||||
(ppe,) <$>
|
||||
OBranchDiff.toOutput
|
||||
loadTypeOfTerm
|
||||
|
||||
@ -40,7 +40,7 @@ getMainTerm loadTypeOfTerm parseNames0 mainName mainType =
|
||||
case HQ.fromString mainName of
|
||||
Nothing -> pure (NotAFunctionName mainName)
|
||||
Just hq -> do
|
||||
let refs = Names3.lookupHQTerm hq (Names3.Names parseNames0 mempty)
|
||||
let refs = Names3.lookupHQTerm hq (Names3.NamesWithHistory parseNames0 mempty)
|
||||
let a = Parser.Ann.External
|
||||
case toList refs of
|
||||
[Referent.Ref ref] -> do
|
||||
|
||||
@ -47,7 +47,7 @@ import qualified Unison.Var as Var
|
||||
import qualified Unison.UnisonFile.Error as UF
|
||||
import Unison.Util.Bytes (Bytes)
|
||||
import Unison.Name as Name
|
||||
import Unison.Names3 (Names)
|
||||
import Unison.Names3 (NamesWithHistory)
|
||||
import qualified Unison.Names.ResolutionResult as Names
|
||||
import Control.Monad.Reader.Class (asks)
|
||||
import qualified Unison.Hashable as Hashable
|
||||
@ -65,7 +65,7 @@ type Err v = P.ParseError (Token Input) (Error v)
|
||||
|
||||
data ParsingEnv =
|
||||
ParsingEnv { uniqueNames :: UniqueName
|
||||
, names :: Names
|
||||
, names :: NamesWithHistory
|
||||
}
|
||||
|
||||
newtype UniqueName = UniqueName (L.Pos -> Int -> Maybe Text)
|
||||
|
||||
@ -80,7 +80,7 @@ unsafeParseFileBuiltinsOnly
|
||||
unsafeParseFileBuiltinsOnly =
|
||||
unsafeReadAndParseFile $ Parser.ParsingEnv
|
||||
mempty
|
||||
(Names.Names Builtin.names0 mempty)
|
||||
(Names.NamesWithHistory Builtin.names0 mempty)
|
||||
|
||||
unsafeParseFile
|
||||
:: String -> Parser.ParsingEnv -> UnisonFile Symbol Ann
|
||||
|
||||
@ -7,18 +7,18 @@ import Unison.Prelude
|
||||
import qualified Data.Set as Set
|
||||
import qualified Unison.HashQualified as HQ
|
||||
import qualified Unison.Name as Name
|
||||
import Unison.Names3 (Names)
|
||||
import Unison.Names3 (NamesWithHistory)
|
||||
import qualified Unison.Names3 as Names
|
||||
import Unison.PrettyPrintEnv (PrettyPrintEnv (PrettyPrintEnv))
|
||||
import Unison.Util.List (safeHead)
|
||||
|
||||
fromNames :: Int -> Names -> PrettyPrintEnv
|
||||
fromNames :: Int -> NamesWithHistory -> PrettyPrintEnv
|
||||
fromNames len names = PrettyPrintEnv terms' types' where
|
||||
terms' r = shortestName . Set.map Name.convert $ Names.termName len r names
|
||||
types' r = shortestName . Set.map Name.convert $ Names.typeName len r names
|
||||
shortestName ns = safeHead $ HQ.sortByLength (toList ns)
|
||||
|
||||
fromSuffixNames :: Int -> Names -> PrettyPrintEnv
|
||||
fromSuffixNames :: Int -> NamesWithHistory -> PrettyPrintEnv
|
||||
fromSuffixNames len names = PrettyPrintEnv terms' types' where
|
||||
terms' r = safeHead $ Names.suffixedTermName len r names
|
||||
types' r = safeHead $ Names.suffixedTypeName len r names
|
||||
|
||||
@ -2,10 +2,10 @@
|
||||
|
||||
module Unison.PrettyPrintEnvDecl.Names where
|
||||
|
||||
import Unison.Names3 (Names)
|
||||
import Unison.Names3 (NamesWithHistory)
|
||||
import Unison.PrettyPrintEnvDecl (PrettyPrintEnvDecl (PrettyPrintEnvDecl))
|
||||
import Unison.PrettyPrintEnv.Names (fromNames, fromSuffixNames)
|
||||
|
||||
fromNamesDecl :: Int -> Names -> PrettyPrintEnvDecl
|
||||
fromNamesDecl :: Int -> NamesWithHistory -> PrettyPrintEnvDecl
|
||||
fromNamesDecl hashLength names =
|
||||
PrettyPrintEnvDecl (fromNames hashLength names) (fromSuffixNames hashLength names)
|
||||
|
||||
@ -1476,7 +1476,7 @@ prettyResolutionFailures s allFailures =
|
||||
|
||||
ppeFromNames0 :: Names3.Names0 -> PPE.PrettyPrintEnv
|
||||
ppeFromNames0 names0 =
|
||||
PPE.fromNames PPE.todoHashLength (Names3.Names {currentNames = names0, oldNames = mempty})
|
||||
PPE.fromNames PPE.todoHashLength (Names3.NamesWithHistory {currentNames = names0, oldNames = mempty})
|
||||
|
||||
prettyRow :: (v, Maybe (NESet String)) -> [(Pretty ColorText, Pretty ColorText)]
|
||||
prettyRow (v, mSet) = case mSet of
|
||||
|
||||
@ -41,7 +41,7 @@ typecheckedFile' :: forall v. Var.Var v => UF.TypecheckedUnisonFile v Ann
|
||||
typecheckedFile' = let
|
||||
tl :: a -> Identity (TL.TypeLookup v Ann)
|
||||
tl = const $ pure (External <$ Builtin.typeLookup)
|
||||
env = Parser.ParsingEnv mempty (Names.Names Builtin.names0 mempty)
|
||||
env = Parser.ParsingEnv mempty (Names.NamesWithHistory Builtin.names0 mempty)
|
||||
r = parseAndSynthesizeFile [] tl env "<IO.u builtin>" source
|
||||
in case runIdentity $ Result.runResultT r of
|
||||
(Nothing, notes) -> error $ "parsing failed: " <> show notes
|
||||
|
||||
@ -56,7 +56,7 @@ import Unison.NameSegment (NameSegment(..))
|
||||
import qualified Unison.NameSegment as NameSegment
|
||||
import qualified Unison.Names2 as Names
|
||||
import Unison.Names3
|
||||
( Names (..),
|
||||
( NamesWithHistory (..),
|
||||
Names0,
|
||||
)
|
||||
import qualified Unison.Names3 as Names3
|
||||
@ -152,7 +152,7 @@ basicNames0' root path = (parseNames00, prettyPrintNames00)
|
||||
basicSuffixifiedNames :: Int -> Branch m -> Path -> PPE.PrettyPrintEnv
|
||||
basicSuffixifiedNames hashLength root path =
|
||||
let names0 = basicPrettyPrintNames0 root path
|
||||
in PPE.suffixifiedPPE . PPE.fromNamesDecl hashLength $ Names names0 mempty
|
||||
in PPE.suffixifiedPPE . PPE.fromNamesDecl hashLength $ NamesWithHistory names0 mempty
|
||||
|
||||
basicPrettyPrintNames0 :: Branch m -> Path -> Names0
|
||||
basicPrettyPrintNames0 root = snd . basicNames0' root
|
||||
@ -445,12 +445,12 @@ termReferentsByShortHash codebase sh = do
|
||||
-- currentPathNames0 :: Path -> Names0
|
||||
-- currentPathNames0 = Branch.toNames0 . Branch.head . Branch.getAt
|
||||
|
||||
getCurrentPrettyNames :: Path -> Branch m -> Names
|
||||
getCurrentPrettyNames :: Path -> Branch m -> NamesWithHistory
|
||||
getCurrentPrettyNames path root =
|
||||
Names (basicPrettyPrintNames0 root path) mempty
|
||||
NamesWithHistory (basicPrettyPrintNames0 root path) mempty
|
||||
|
||||
getCurrentParseNames :: Path -> Branch m -> Names
|
||||
getCurrentParseNames path root = Names (basicParseNames0 root path) mempty
|
||||
getCurrentParseNames :: Path -> Branch m -> NamesWithHistory
|
||||
getCurrentParseNames path root = NamesWithHistory (basicParseNames0 root path) mempty
|
||||
|
||||
-- Any absolute names in the input which have `root` as a prefix
|
||||
-- are converted to names relative to current path. All other names are
|
||||
@ -477,7 +477,7 @@ data Search r = Search
|
||||
}
|
||||
|
||||
-- | Make a type search, given a short hash length and names to search in.
|
||||
makeTypeSearch :: Int -> Names -> Search Reference
|
||||
makeTypeSearch :: Int -> NamesWithHistory -> Search Reference
|
||||
makeTypeSearch len names =
|
||||
Search
|
||||
{ lookupNames = \ref -> Names3.typeName len ref names,
|
||||
@ -487,7 +487,7 @@ makeTypeSearch len names =
|
||||
}
|
||||
|
||||
-- | Make a term search, given a short hash length and names to search in.
|
||||
makeTermSearch :: Int -> Names -> Search Referent
|
||||
makeTermSearch :: Int -> NamesWithHistory -> Search Referent
|
||||
makeTermSearch len names =
|
||||
Search
|
||||
{ lookupNames = \ref -> Names3.termName len ref names,
|
||||
|
||||
@ -14,7 +14,7 @@ import Control.Monad.Reader (asks, local)
|
||||
import Data.Foldable (foldrM)
|
||||
import Prelude hiding (and, or, seq)
|
||||
import Unison.Name (Name)
|
||||
import Unison.Names3 (Names)
|
||||
import Unison.Names3 (NamesWithHistory)
|
||||
import Unison.Reference (Reference)
|
||||
import Unison.Referent (Referent)
|
||||
import Unison.Parser hiding (seq)
|
||||
@ -993,7 +993,7 @@ instance Show v => Show (BlockElement v) where
|
||||
-- subst
|
||||
-- use Foo.Bar + blah
|
||||
-- use Bar.Baz zonk zazzle
|
||||
imports :: Var v => P v (Names, [(v,v)])
|
||||
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
|
||||
@ -1003,7 +1003,7 @@ imports = do
|
||||
-- A key feature of imports is we want to be able to say:
|
||||
-- `use foo.bar Baz qux` without having to specify whether `Baz` or `qux` are
|
||||
-- terms or types.
|
||||
substImports :: Var v => Names -> [(v,v)] -> Term v Ann -> Term v Ann
|
||||
substImports :: Var v => NamesWithHistory -> [(v,v)] -> Term v Ann -> Term v Ann
|
||||
substImports ns imports =
|
||||
ABT.substsInheritAnnotation [ (suffix, Term.var () full)
|
||||
| (suffix,full) <- imports ] . -- no guard here, as `full` could be bound
|
||||
|
||||
@ -4,10 +4,10 @@
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
{-# LANGUAGE ViewPatterns #-}
|
||||
|
||||
module Unison.Names2
|
||||
( Names0
|
||||
, Names'(Names)
|
||||
, Names
|
||||
module Unison.Names
|
||||
( UnqualifiedNames
|
||||
, Names'(Names')
|
||||
, HQNames
|
||||
, addTerm
|
||||
, addType
|
||||
, allReferences
|
||||
@ -66,24 +66,25 @@ import qualified Unison.Util.Relation as R
|
||||
import qualified Unison.ShortHash as SH
|
||||
import Unison.ShortHash (ShortHash)
|
||||
import qualified Text.FuzzyFind as FZF
|
||||
import Unison.Names2 (Names'(HQNames))
|
||||
|
||||
-- This will support the APIs of both PrettyPrintEnv and the old Names.
|
||||
-- This will support the APIs of both PrettyPrintEnv and the old HQNames.
|
||||
-- For pretty-printing, we need to look up names for References; they may have
|
||||
-- some hash-qualification, depending on the context.
|
||||
-- For parsing (both .u files and command-line args)
|
||||
data Names' n = Names
|
||||
data Names' n = Names'
|
||||
{ terms :: Relation n Referent
|
||||
, types :: Relation n Reference
|
||||
} deriving (Eq,Ord)
|
||||
|
||||
type Names = Names' (HashQualified Name)
|
||||
type Names0 = Names' Name
|
||||
type HQNames = Names' (HashQualified Name)
|
||||
type UnqualifiedNames = Names' Name
|
||||
|
||||
-- Finds names that are supersequences of all the given strings, ordered by
|
||||
-- score and grouped by name.
|
||||
fuzzyFind
|
||||
:: [String]
|
||||
-> Names0
|
||||
-> UnqualifiedNames
|
||||
-> [(FZF.Alignment, Name, Set (Either Referent Reference))]
|
||||
fuzzyFind query names =
|
||||
fmap flatten
|
||||
@ -119,8 +120,8 @@ fuzzyFind query names =
|
||||
query
|
||||
)
|
||||
|
||||
names0ToNames :: Names0 -> Names
|
||||
names0ToNames names0 = Names terms' types' where
|
||||
names0ToNames :: UnqualifiedNames -> HQNames
|
||||
names0ToNames names0 = HQNames terms' types' where
|
||||
terms' = R.map doTerm (terms names0)
|
||||
types' = R.map doType (types names0)
|
||||
length = numHashChars names0
|
||||
@ -134,15 +135,15 @@ names0ToNames names0 = Names terms' types' where
|
||||
else (HQ.NameOnly n, r)
|
||||
|
||||
termReferences, typeReferences, allReferences :: Names' n -> Set Reference
|
||||
termReferences Names{..} = Set.map Referent.toReference $ R.ran terms
|
||||
typeReferences Names{..} = R.ran types
|
||||
termReferences HQNames{..} = Set.map Referent.toReference $ R.ran terms
|
||||
typeReferences HQNames{..} = R.ran types
|
||||
allReferences n = termReferences n <> typeReferences n
|
||||
|
||||
termReferents :: Names' n -> Set Referent
|
||||
termReferents Names{..} = R.ran terms
|
||||
termReferents HQNames{..} = R.ran terms
|
||||
|
||||
restrictReferences :: Ord n => Set Reference -> Names' n -> Names' n
|
||||
restrictReferences refs Names{..} = Names terms' types' where
|
||||
restrictReferences refs HQNames{..} = HQNames terms' types' where
|
||||
terms' = R.filterRan ((`Set.member` refs) . Referent.toReference) terms
|
||||
types' = R.filterRan (`Set.member` refs) types
|
||||
|
||||
@ -169,15 +170,15 @@ restrictReferences refs Names{..} = Names terms' types' where
|
||||
--
|
||||
-- For pretty-printing:
|
||||
-- Probably don't want to add new aliases, unless we don't know which
|
||||
-- `Names` is higher priority. So if we do have a preferred `Names`,
|
||||
-- `HQNames` is higher priority. So if we do have a preferred `HQNames`,
|
||||
-- don't use `unionLeftName` or (<>).
|
||||
-- You don't want to create new conflicts either if you have a preferred
|
||||
-- `Names`. So in this case, don't use `unionLeftRef` either.
|
||||
-- `HQNames`. So in this case, don't use `unionLeftRef` either.
|
||||
-- I guess that leaves `unionLeft`.
|
||||
--
|
||||
-- Not sure if the above is helpful or correct!
|
||||
|
||||
-- unionLeft two Names, including new aliases, but excluding new name conflicts.
|
||||
-- unionLeft two HQNames, including new aliases, but excluding new name conflicts.
|
||||
-- e.g. unionLeftName [foo -> #a, bar -> #a, cat -> #c]
|
||||
-- [foo -> #b, baz -> #c]
|
||||
-- = [foo -> #a, bar -> #a, baz -> #c, cat -> #c)]
|
||||
@ -186,14 +187,14 @@ restrictReferences refs Names{..} = Names terms' types' where
|
||||
unionLeftName :: Ord n => Names' n -> Names' n -> Names' n
|
||||
unionLeftName = unionLeft' $ const . R.memberDom
|
||||
|
||||
-- unionLeft two Names, including new name conflicts, but excluding new aliases.
|
||||
-- unionLeft two HQNames, including new name conflicts, but excluding new aliases.
|
||||
-- e.g. unionLeftRef [foo -> #a, bar -> #a, cat -> #c]
|
||||
-- [foo -> #b, baz -> #c]
|
||||
-- = [foo -> #a, bar -> #a, foo -> #b, cat -> #c]
|
||||
_unionLeftRef :: Ord n => Names' n -> Names' n -> Names' n
|
||||
_unionLeftRef = unionLeft' $ const R.memberRan
|
||||
|
||||
-- unionLeft two Names, but don't create new aliases or new name conflicts.
|
||||
-- unionLeft two HQNames, but don't create new aliases or new name conflicts.
|
||||
-- e.g. unionLeft [foo -> #a, bar -> #a, cat -> #c]
|
||||
-- [foo -> #b, baz -> #c]
|
||||
-- = [foo -> #a, bar -> #a, cat -> #c]
|
||||
@ -208,14 +209,14 @@ unionLeft'
|
||||
-> Names' n
|
||||
-> Names' n
|
||||
-> Names' n
|
||||
unionLeft' p a b = Names terms' types'
|
||||
unionLeft' p a b = HQNames terms' types'
|
||||
where
|
||||
terms' = foldl' go (terms a) (R.toList $ terms b)
|
||||
types' = foldl' go (types a) (R.toList $ types b)
|
||||
go :: (Ord a, Ord b) => Relation a b -> (a, b) -> Relation a b
|
||||
go acc (n, r) = if p n r acc then acc else R.insert n r acc
|
||||
|
||||
-- could move this to a read-only field in Names
|
||||
-- could move this to a read-only field in HQNames
|
||||
-- todo: kill this function and pass thru an Int from the codebase, I suppose
|
||||
numHashChars :: Names' n -> Int
|
||||
numHashChars b = lenFor hashes
|
||||
@ -273,7 +274,7 @@ hqName b n = \case
|
||||
ambiguous = Set.size (termsNamed b n) + Set.size (typesNamed b n) > 1
|
||||
|
||||
-- Conditionally apply hash qualifier to term name.
|
||||
-- Should be the same as the input name if the Names0 is unconflicted.
|
||||
-- Should be the same as the input name if the UnqualifiedNames is unconflicted.
|
||||
hqTermName :: (Ord n, Alphabetical n) => Int -> Names' n -> n -> Referent -> HQ.HashQualified n
|
||||
hqTermName hqLen b n r = if Set.size (termsNamed b n) > 1
|
||||
then hqTermName' hqLen n r
|
||||
@ -302,7 +303,7 @@ _hqTermAliases :: (Ord n, Alphabetical n) => Names' n -> n -> Referent -> Set (H
|
||||
_hqTermAliases b n r = Set.map (flip (_hqTermName b) r) (termAliases b n r)
|
||||
|
||||
-- Unconditionally apply hash qualifier long enough to distinguish all the
|
||||
-- References in this Names0.
|
||||
-- References in this UnqualifiedNames.
|
||||
hqTermName' :: Int -> n -> Referent -> HQ.HashQualified n
|
||||
hqTermName' hqLen n r =
|
||||
HQ.take hqLen $ HQ.fromNamedReferent n r
|
||||
@ -320,39 +321,39 @@ _hqTypeName' b n r =
|
||||
HQ.take (numHashChars b) $ HQ.fromNamedReference n r
|
||||
|
||||
fromTerms :: Ord n => [(n, Referent)] -> Names' n
|
||||
fromTerms ts = Names (R.fromList ts) mempty
|
||||
fromTerms ts = HQNames (R.fromList ts) mempty
|
||||
|
||||
fromTypes :: Ord n => [(n, Reference)] -> Names' n
|
||||
fromTypes ts = Names mempty (R.fromList ts)
|
||||
fromTypes ts = HQNames mempty (R.fromList ts)
|
||||
|
||||
prefix0 :: Name -> Names0 -> Names0
|
||||
prefix0 n (Names terms types) = Names terms' types' where
|
||||
prefix0 :: Name -> UnqualifiedNames -> UnqualifiedNames
|
||||
prefix0 n (HQNames terms types) = HQNames terms' types' where
|
||||
terms' = R.mapDom (Name.joinDot n) terms
|
||||
types' = R.mapDom (Name.joinDot n) types
|
||||
|
||||
filter :: Ord n => (n -> Bool) -> Names' n -> Names' n
|
||||
filter f (Names terms types) = Names (R.filterDom f terms) (R.filterDom f types)
|
||||
filter f (HQNames terms types) = HQNames (R.filterDom f terms) (R.filterDom f types)
|
||||
|
||||
-- currently used for filtering before a conditional `add`
|
||||
filterByHQs :: Set (HashQualified Name) -> Names0 -> Names0
|
||||
filterByHQs hqs Names{..} = Names terms' types' where
|
||||
filterByHQs :: Set (HashQualified Name) -> UnqualifiedNames -> UnqualifiedNames
|
||||
filterByHQs hqs HQNames{..} = HQNames terms' types' where
|
||||
terms' = R.filter f terms
|
||||
types' = R.filter g types
|
||||
f (n, r) = any (HQ.matchesNamedReferent n r) hqs
|
||||
g (n, r) = any (HQ.matchesNamedReference n r) hqs
|
||||
|
||||
filterBySHs :: Set ShortHash -> Names0 -> Names0
|
||||
filterBySHs shs Names{..} = Names terms' types' where
|
||||
filterBySHs :: Set ShortHash -> UnqualifiedNames -> UnqualifiedNames
|
||||
filterBySHs shs HQNames{..} = HQNames terms' types' where
|
||||
terms' = R.filter f terms
|
||||
types' = R.filter g types
|
||||
f (_n, r) = any (`SH.isPrefixOf` Referent.toShortHash r) shs
|
||||
g (_n, r) = any (`SH.isPrefixOf` Reference.toShortHash r) shs
|
||||
|
||||
filterTypes :: Ord n => (n -> Bool) -> Names' n -> Names' n
|
||||
filterTypes f (Names terms types) = Names terms (R.filterDom f types)
|
||||
filterTypes f (HQNames terms types) = HQNames terms (R.filterDom f types)
|
||||
|
||||
difference :: Ord n => Names' n -> Names' n -> Names' n
|
||||
difference a b = Names (R.difference (terms a) (terms b))
|
||||
difference a b = HQNames (R.difference (terms a) (terms b))
|
||||
(R.difference (types a) (types b))
|
||||
|
||||
contains :: Names' n -> Reference -> Bool
|
||||
@ -363,17 +364,17 @@ contains names r =
|
||||
|
||||
-- | filters out everything from the domain except what's conflicted
|
||||
conflicts :: Ord n => Names' n -> Names' n
|
||||
conflicts Names{..} = Names (R.filterManyDom terms) (R.filterManyDom types)
|
||||
conflicts HQNames{..} = HQNames (R.filterManyDom terms) (R.filterManyDom types)
|
||||
|
||||
instance Ord n => Semigroup (Names' n) where (<>) = mappend
|
||||
|
||||
instance Ord n => Monoid (Names' n) where
|
||||
mempty = Names mempty mempty
|
||||
Names e1 t1 `mappend` Names e2 t2 =
|
||||
Names (e1 <> e2) (t1 <> t2)
|
||||
mempty = HQNames mempty mempty
|
||||
HQNames e1 t1 `mappend` HQNames e2 t2 =
|
||||
HQNames (e1 <> e2) (t1 <> t2)
|
||||
|
||||
instance Show n => Show (Names' n) where
|
||||
show (Names terms types) = "Terms:\n" ++
|
||||
show (HQNames 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"
|
||||
@ -1,6 +1,6 @@
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
|
||||
module Unison.Names3 where
|
||||
module Unison.NamesWithHistory where
|
||||
|
||||
import Unison.Prelude
|
||||
|
||||
@ -17,25 +17,23 @@ import Unison.Util.Relation (Relation)
|
||||
import qualified Data.Set as Set
|
||||
import qualified Data.Map as Map
|
||||
import qualified Unison.Name as Name
|
||||
import qualified Unison.Names2
|
||||
import qualified Unison.Names2 as Names
|
||||
import qualified Unison.Names as Names
|
||||
import qualified Unison.Util.List as List
|
||||
import qualified Unison.Util.Relation as R
|
||||
import qualified Unison.ConstructorType as CT
|
||||
|
||||
data Names = Names
|
||||
data NamesWithHistory = NamesWithHistory
|
||||
{ -- | currentNames represent references which are named in the current version of the namespace.
|
||||
currentNames :: Names0,
|
||||
currentNames :: Names.UnqualifiedNames,
|
||||
-- | oldNames represent things which no longer have names in the current version of the
|
||||
-- codebase, but which may have previously had names. This may allow us to show more helpful
|
||||
-- context to users rather than just a hash.
|
||||
oldNames :: Names0
|
||||
oldNames :: Names.UnqualifiedNames
|
||||
}
|
||||
deriving (Show)
|
||||
|
||||
type Names0 = Unison.Names2.Names0
|
||||
pattern Names0 :: Relation n Referent -> Relation n Reference -> Names.Names' n
|
||||
pattern Names0 terms types = Unison.Names2.Names terms types
|
||||
pattern Names0 terms types = Names2.HQNames terms types
|
||||
|
||||
filterTypes :: (Name -> Bool) -> Names0 -> Names0
|
||||
filterTypes = Unison.Names2.filterTypes
|
||||
@ -67,8 +65,8 @@ 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.
|
||||
push :: Names0 -> Names -> Names
|
||||
push n0 ns = Names (unionLeft0 n1 cur) (oldNames ns <> shadowed) where
|
||||
push :: Names0 -> NamesWithHistory -> NamesWithHistory
|
||||
push n0 ns = NamesWithHistory (unionLeft0 n1 cur) (oldNames ns <> shadowed) where
|
||||
n1 = suffixify0 n0
|
||||
cur = currentNames ns
|
||||
shadowed = names0 terms' types' where
|
||||
@ -121,9 +119,9 @@ terms0 = Names.terms
|
||||
-- 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`.
|
||||
shadowing :: Names0 -> Names -> Names
|
||||
shadowing prio (Names current old) =
|
||||
Names (prio `unionLeftName0` current) (current <> old)
|
||||
shadowing :: Names0 -> NamesWithHistory -> NamesWithHistory
|
||||
shadowing prio (NamesWithHistory current old) =
|
||||
NamesWithHistory (prio `unionLeftName0` current) (current <> old)
|
||||
|
||||
makeAbsolute0 :: Names0 -> Names0
|
||||
makeAbsolute0 = map0 Name.makeAbsolute
|
||||
@ -131,8 +129,8 @@ makeAbsolute0 = map0 Name.makeAbsolute
|
||||
-- Find all types whose name has a suffix matching the provided `HashQualified`,
|
||||
-- returning types with relative names if they exist, and otherwise
|
||||
-- returning types with absolute names.
|
||||
lookupRelativeHQType :: HashQualified Name -> Names -> Set Reference
|
||||
lookupRelativeHQType hq ns@Names {..} =
|
||||
lookupRelativeHQType :: HashQualified Name -> NamesWithHistory -> Set Reference
|
||||
lookupRelativeHQType hq ns@NamesWithHistory {..} =
|
||||
let rs = lookupHQType hq ns
|
||||
keep r = any (not . Name.isAbsolute) (R.lookupRan r (Names.types currentNames))
|
||||
in case Set.filter keep rs of
|
||||
@ -140,31 +138,31 @@ lookupRelativeHQType hq ns@Names {..} =
|
||||
| Set.null rs' -> rs
|
||||
| otherwise -> rs'
|
||||
|
||||
lookupRelativeHQType' :: HQ'.HashQualified Name -> Names -> Set Reference
|
||||
lookupRelativeHQType' :: HQ'.HashQualified Name -> NamesWithHistory -> Set Reference
|
||||
lookupRelativeHQType' =
|
||||
lookupRelativeHQType . HQ'.toHQ
|
||||
|
||||
-- | Find all types whose name has a suffix matching the provided 'HashQualified'.
|
||||
lookupHQType :: HashQualified Name -> Names -> Set Reference
|
||||
lookupHQType :: HashQualified Name -> NamesWithHistory -> Set Reference
|
||||
lookupHQType =
|
||||
lookupHQRef Names.types Reference.isPrefixOf
|
||||
|
||||
-- | Find all types whose name has a suffix matching the provided 'HashQualified''. See 'lookupHQType'.
|
||||
lookupHQType' :: HQ'.HashQualified Name -> Names -> Set Reference
|
||||
lookupHQType' :: HQ'.HashQualified Name -> NamesWithHistory -> Set Reference
|
||||
lookupHQType' =
|
||||
lookupHQType . HQ'.toHQ
|
||||
|
||||
hasTermNamed :: Name -> Names -> Bool
|
||||
hasTermNamed :: Name -> NamesWithHistory -> Bool
|
||||
hasTermNamed n ns = not (Set.null $ lookupHQTerm (HQ.NameOnly n) ns)
|
||||
|
||||
hasTypeNamed :: Name -> Names -> Bool
|
||||
hasTypeNamed :: Name -> NamesWithHistory -> Bool
|
||||
hasTypeNamed n ns = not (Set.null $ lookupHQType (HQ.NameOnly n) ns)
|
||||
|
||||
-- Find all terms whose name has a suffix matching the provided `HashQualified`,
|
||||
-- returning terms with relative names if they exist, and otherwise
|
||||
-- returning terms with absolute names.
|
||||
lookupRelativeHQTerm :: HashQualified Name -> Names -> Set Referent
|
||||
lookupRelativeHQTerm hq ns@Names {..} =
|
||||
lookupRelativeHQTerm :: HashQualified Name -> NamesWithHistory -> Set Referent
|
||||
lookupRelativeHQTerm hq ns@NamesWithHistory {..} =
|
||||
let rs = lookupHQTerm hq ns
|
||||
keep r = any (not . Name.isAbsolute) (R.lookupRan r (Names.terms currentNames))
|
||||
in case Set.filter keep rs of
|
||||
@ -172,7 +170,7 @@ lookupRelativeHQTerm hq ns@Names {..} =
|
||||
| Set.null rs' -> rs
|
||||
| otherwise -> rs'
|
||||
|
||||
lookupRelativeHQTerm' :: HQ'.HashQualified Name -> Names -> Set Referent
|
||||
lookupRelativeHQTerm' :: HQ'.HashQualified Name -> NamesWithHistory -> Set Referent
|
||||
lookupRelativeHQTerm' =
|
||||
lookupRelativeHQTerm . HQ'.toHQ
|
||||
|
||||
@ -180,12 +178,12 @@ lookupRelativeHQTerm' =
|
||||
--
|
||||
-- If the hash-qualified name does not include a hash, then only current names are searched. Otherwise, old names are
|
||||
-- searched, too, if searching current names produces no hits.
|
||||
lookupHQTerm :: HashQualified Name -> Names -> Set Referent
|
||||
lookupHQTerm :: HashQualified Name -> NamesWithHistory -> Set Referent
|
||||
lookupHQTerm =
|
||||
lookupHQRef Names.terms Referent.isPrefixOf
|
||||
|
||||
-- | Find all terms whose name has a suffix matching the provided 'HashQualified''. See 'lookupHQTerm'.
|
||||
lookupHQTerm' :: HQ'.HashQualified Name -> Names -> Set Referent
|
||||
lookupHQTerm' :: HQ'.HashQualified Name -> NamesWithHistory -> Set Referent
|
||||
lookupHQTerm' =
|
||||
lookupHQTerm . HQ'.toHQ
|
||||
|
||||
@ -201,9 +199,9 @@ lookupHQRef ::
|
||||
(ShortHash -> r -> Bool) ->
|
||||
-- | The name to look up
|
||||
HashQualified Name ->
|
||||
Names ->
|
||||
NamesWithHistory ->
|
||||
Set r
|
||||
lookupHQRef which isPrefixOf hq Names {currentNames, oldNames} =
|
||||
lookupHQRef which isPrefixOf hq NamesWithHistory {currentNames, oldNames} =
|
||||
case hq of
|
||||
HQ.NameOnly n -> Name.searchBySuffix n currentRefs
|
||||
HQ.HashQualified n sh -> matches currentRefs `orIfEmpty` matches oldRefs
|
||||
@ -228,8 +226,8 @@ lookupHQRef which isPrefixOf hq Names {currentNames, oldNames} =
|
||||
-- If `r` is in "current" names, look up each of its names, and hash-qualify
|
||||
-- them if they are conflicted names. If `r` isn't in "current" names, look up
|
||||
-- each of its "old" names and hash-qualify them.
|
||||
typeName :: Int -> Reference -> Names -> Set (HQ'.HashQualified Name)
|
||||
typeName length r Names{..} =
|
||||
typeName :: Int -> Reference -> NamesWithHistory -> Set (HQ'.HashQualified Name)
|
||||
typeName length r NamesWithHistory{..} =
|
||||
if R.memberRan r . Names.types $ currentNames
|
||||
then Set.map (\n -> if isConflicted n then hq n else HQ'.fromName n)
|
||||
(R.lookupRan r . Names.types $ currentNames)
|
||||
@ -238,21 +236,21 @@ typeName length r Names{..} =
|
||||
isConflicted n = R.manyDom n (Names.types currentNames)
|
||||
|
||||
-- List of names for a referent, longer names (by number of segments) first.
|
||||
termNamesByLength :: Int -> Referent -> Names -> [HQ'.HashQualified Name]
|
||||
termNamesByLength :: Int -> Referent -> NamesWithHistory -> [HQ'.HashQualified Name]
|
||||
termNamesByLength length r ns =
|
||||
sortOn len (toList $ termName length r ns)
|
||||
where len (HQ'.NameOnly n) = Name.countSegments n
|
||||
len (HQ'.HashQualified n _) = Name.countSegments n
|
||||
|
||||
-- The longest term name (by segment count) for a `Referent`.
|
||||
longestTermName :: Int -> Referent -> Names -> HQ.HashQualified Name
|
||||
longestTermName :: Int -> Referent -> NamesWithHistory -> HQ.HashQualified Name
|
||||
longestTermName length r ns =
|
||||
case reverse (termNamesByLength length r ns) of
|
||||
[] -> HQ.take length (HQ.fromReferent r)
|
||||
(h : _) -> Name.convert h
|
||||
|
||||
termName :: Int -> Referent -> Names -> Set (HQ'.HashQualified Name)
|
||||
termName length r Names{..} =
|
||||
termName :: Int -> Referent -> NamesWithHistory -> Set (HQ'.HashQualified Name)
|
||||
termName length r NamesWithHistory{..} =
|
||||
if R.memberRan r . Names.terms $ currentNames
|
||||
then Set.map (\n -> if isConflicted n then hq n else HQ'.fromName n)
|
||||
(R.lookupRan r . Names.terms $ currentNames)
|
||||
@ -260,8 +258,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 -> [HQ.HashQualified Name]
|
||||
suffixedTermName :: Int -> Referent -> Names -> [HQ.HashQualified Name]
|
||||
suffixedTypeName :: Int -> Reference -> NamesWithHistory -> [HQ.HashQualified Name]
|
||||
suffixedTermName :: Int -> Referent -> NamesWithHistory -> [HQ.HashQualified Name]
|
||||
(suffixedTermName,suffixedTypeName) =
|
||||
( suffixedName termName (Names.terms . currentNames) HQ'.fromNamedReferent
|
||||
, suffixedName typeName (Names.types . currentNames) HQ'.fromNamedReference )
|
||||
@ -291,7 +289,7 @@ suffixedTermName :: Int -> Referent -> Names -> [HQ.HashQualified Name]
|
||||
lookupHQPattern
|
||||
:: HQ.HashQualified Name
|
||||
-> CT.ConstructorType
|
||||
-> Names
|
||||
-> NamesWithHistory
|
||||
-> Set (Reference, Int)
|
||||
lookupHQPattern hq ctt names = Set.fromList
|
||||
[ (r, cid)
|
||||
@ -319,7 +317,7 @@ constructorsForType0 r ns = let
|
||||
-- anything else that is currently called `Some`.
|
||||
--
|
||||
-- Only affects `currentNames`.
|
||||
importing :: [(Name, Name)] -> Names -> Names
|
||||
importing :: [(Name, Name)] -> NamesWithHistory -> NamesWithHistory
|
||||
importing shortToLongName ns =
|
||||
ns { currentNames = importing0 shortToLongName (currentNames ns) }
|
||||
|
||||
@ -122,7 +122,7 @@ bindNames keepFreeTerms ns0 e = do
|
||||
-- !_ = traceShow $ fst <$> freeTmVars
|
||||
freeTyVars = [ (v, a) | (v,as) <- Map.toList (freeTypeVarAnnotations e)
|
||||
, a <- as ]
|
||||
ns = Names.Names ns0 mempty
|
||||
ns = Names.NamesWithHistory ns0 mempty
|
||||
-- !_ = trace "bindNames.free type vars: " ()
|
||||
-- !_ = traceShow $ fst <$> freeTyVars
|
||||
okTm :: (v,a) -> Names.ResolutionResult v a (v, Term v a)
|
||||
|
||||
@ -26,7 +26,7 @@ bindNames
|
||||
-> Type v a
|
||||
-> Names.ResolutionResult v a (Type v a)
|
||||
bindNames keepFree ns0 t = let
|
||||
ns = Names.Names ns0 mempty
|
||||
ns = Names.NamesWithHistory ns0 mempty
|
||||
fvs = ABT.freeVarOccurrences keepFree t
|
||||
rs = [(v, a, Names.lookupHQType (Name.convert $ Name.fromVar v) ns) | (v,a) <- fvs ]
|
||||
ok (v, a, rs) =
|
||||
|
||||
@ -37,10 +37,10 @@ library
|
||||
Unison.Kind
|
||||
Unison.LabeledDependency
|
||||
Unison.Name
|
||||
Unison.Names
|
||||
Unison.Names.ResolutionResult
|
||||
Unison.Names2
|
||||
Unison.Names3
|
||||
Unison.NameSegment
|
||||
Unison.NamesWithHistory
|
||||
Unison.Paths
|
||||
Unison.Pattern
|
||||
Unison.Reference
|
||||
|
||||
Loading…
Reference in New Issue
Block a user