module Unison.FileParsers
  ( ShouldUseTndr (..),
    computeTypecheckingEnvironment,
    synthesizeFile,
  )
where

import Control.Lens
import Control.Monad.State (evalStateT)
import Data.Foldable qualified as Foldable
import Data.List (partition)
import Data.List qualified as List
import Data.List.NonEmpty qualified as NonEmpty
import Data.Map qualified as Map
import Data.Ord (clamp)
import Data.Sequence qualified as Seq
import Data.Set qualified as Set
import Data.Text qualified as Text
import Unison.ABT qualified as ABT
import Unison.Blank qualified as Blank
import Unison.Builtin qualified as Builtin
import Unison.ConstructorReference qualified as ConstructorReference
import Unison.Name (Name)
import Unison.Name qualified as Name
import Unison.NameSegment qualified as NameSegment
import Unison.Names qualified as Names
import Unison.Names.ResolvesTo (ResolvesTo (..))
import Unison.Parser.Ann (Ann)
import Unison.Prelude
import Unison.PrettyPrintEnv.Names qualified as PPE
import Unison.Reference (TermReference, TypeReference)
import Unison.Referent (Referent)
import Unison.Referent qualified as Referent
import Unison.Result (CompilerBug (..), Note (..), ResultT, pattern Result)
import Unison.Result qualified as Result
import Unison.Syntax.Name qualified as Name (toText, unsafeParseText, unsafeParseVar)
import Unison.Syntax.Parser qualified as Parser
import Unison.Term qualified as Term
import Unison.Type qualified as Type
import Unison.Typechecker qualified as Typechecker
import Unison.Typechecker.Context qualified as Context
import Unison.Typechecker.Extractor (RedundantTypeAnnotation)
import Unison.Typechecker.TypeLookup qualified as TL
import Unison.UnisonFile (definitionLocation)
import Unison.UnisonFile qualified as UF
import Unison.UnisonFile.Names qualified as UF
import Unison.Util.Defns (Defns (..), DefnsF)
import Unison.Util.List qualified as List
import Unison.Util.Map qualified as Map (upsert)
import Unison.Util.Relation (Relation)
import Unison.Util.Relation qualified as Rel
import Unison.Var (Var)
import Unison.Var qualified as Var
import Unison.WatchKind (WatchKind)

type Term v = Term.Term v Ann

type Type v = Type.Type v Ann

type UnisonFile v = UF.UnisonFile v Ann

-- each round of TDNR emits its own TopLevelComponent notes, so we remove
-- duplicates (based on var name and location), preferring the later note as
-- that will have the latest typechecking info
convertNotes :: (Ord v) => Typechecker.Notes v ann -> Seq (Note v ann)
convertNotes :: forall v ann. Ord v => Notes v ann -> Seq (Note v ann)
convertNotes (Typechecker.Notes Seq (CompilerBug v ann)
bugs Seq (ErrorNote v ann)
es Seq (InfoNote v ann)
is) =
  (CompilerBug v ann -> Note v ann
forall v loc. CompilerBug v loc -> Note v loc
CompilerBug (CompilerBug v ann -> Note v ann)
-> (CompilerBug v ann -> CompilerBug v ann)
-> CompilerBug v ann
-> Note v ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CompilerBug v ann -> CompilerBug v ann
forall v loc. CompilerBug v loc -> CompilerBug v loc
TypecheckerBug (CompilerBug v ann -> Note v ann)
-> Seq (CompilerBug v ann) -> Seq (Note v ann)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Seq (CompilerBug v ann)
bugs) Seq (Note v ann) -> Seq (Note v ann) -> Seq (Note v ann)
forall a. Semigroup a => a -> a -> a
<> (ErrorNote v ann -> Note v ann
forall v loc. ErrorNote v loc -> Note v loc
TypeError (ErrorNote v ann -> Note v ann)
-> Seq (ErrorNote v ann) -> Seq (Note v ann)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Seq (ErrorNote v ann)
es) Seq (Note v ann) -> Seq (Note v ann) -> Seq (Note v ann)
forall a. Semigroup a => a -> a -> a
<> (InfoNote v ann -> Note v ann
forall v loc. InfoNote v loc -> Note v loc
TypeInfo (InfoNote v ann -> Note v ann)
-> Seq (InfoNote v ann) -> Seq (Note v ann)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [InfoNote v ann] -> Seq (InfoNote v ann)
forall a. [a] -> Seq a
Seq.fromList [InfoNote v ann]
is')
  where
    is' :: [InfoNote v ann]
is' = (Word, InfoNote v ann) -> InfoNote v ann
forall a b. (a, b) -> b
snd ((Word, InfoNote v ann) -> InfoNote v ann)
-> [(Word, InfoNote v ann)] -> [InfoNote v ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Word, InfoNote v ann) -> Either Word [v])
-> [(Word, InfoNote v ann)] -> [(Word, InfoNote v ann)]
forall (f :: * -> *) b a.
(Foldable f, Ord b) =>
(a -> b) -> f a -> [a]
List.uniqueBy' (Word, InfoNote v ann) -> Either Word [v]
forall {a} {a} {loc}. (a, InfoNote a loc) -> Either a [a]
f ([(Word
1 :: Word) ..] [Word] -> [InfoNote v ann] -> [(Word, InfoNote v ann)]
forall a b. [a] -> [b] -> [(a, b)]
`zip` Seq (InfoNote v ann) -> [InfoNote v ann]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList Seq (InfoNote v ann)
is)
    f :: (a, InfoNote a loc) -> Either a [a]
f (a
_, Context.TopLevelComponent [(a, Type a loc, RedundantTypeAnnotation)]
cs) = [a] -> Either a [a]
forall a b. b -> Either a b
Right [a
v | (a
v, Type a loc
_, RedundantTypeAnnotation
_) <- [(a, Type a loc, RedundantTypeAnnotation)]
cs]
    f (a
i, InfoNote a loc
_) = a -> Either a [a]
forall a b. a -> Either a b
Left a
i

-- | Should we use type-directed name resolution?
data ShouldUseTndr m
  = ShouldUseTndr'No
  | ShouldUseTndr'Yes (Parser.ParsingEnv m)

-- | Compute a typechecking environment, given:
--
--     * Whether or not to use type-directed name resolution during type checking.
--     * The abilities that are considered to already have ambient handlers.
--     * A function to compute a @TypeLookup@ for the given set of type- or term-references.
--     * The parsing environment that was used to parse the parsed Unison file.
--     * The parsed Unison file for which the typechecking environment is applicable.
computeTypecheckingEnvironment ::
  forall m v.
  (Var v, Monad m) =>
  ShouldUseTndr m ->
  [Type v] ->
  (DefnsF Set TermReference TypeReference -> m (TL.TypeLookup v Ann)) ->
  UnisonFile v ->
  m (Typechecker.Env v Ann)
computeTypecheckingEnvironment :: forall (m :: * -> *) v.
(Var v, Monad m) =>
ShouldUseTndr m
-> [Type v]
-> (DefnsF Set TermReference TermReference -> m (TypeLookup v Ann))
-> UnisonFile v
-> m (Env v Ann)
computeTypecheckingEnvironment ShouldUseTndr m
shouldUseTndr [Type v]
ambientAbilities DefnsF Set TermReference TermReference -> m (TypeLookup v Ann)
typeLookupf UnisonFile v
uf =
  case ShouldUseTndr m
shouldUseTndr of
    ShouldUseTndr m
ShouldUseTndr'No -> do
      TypeLookup v Ann
tl <- DefnsF Set TermReference TermReference -> m (TypeLookup v Ann)
typeLookupf (UnisonFile v -> DefnsF Set TermReference TermReference
forall a v.
(Monoid a, Var v) =>
UnisonFile v a -> DefnsF Set TermReference TermReference
UF.dependencies UnisonFile v
uf)
      pure
        Typechecker.Env
          { $sel:ambientAbilities:Env :: [Type v]
ambientAbilities = [Type v]
ambientAbilities,
            $sel:typeLookup:Env :: TypeLookup v Ann
typeLookup = TypeLookup v Ann
tl,
            $sel:termsByShortname:Env :: Map Name [Either Name (NamedReference v Ann)]
termsByShortname = Map Name [Either Name (NamedReference v Ann)]
forall k a. Map k a
Map.empty,
            $sel:freeNameToFuzzyTermsByShortName:Env :: Map Name (Map Name [Either Name (NamedReference v Ann)])
freeNameToFuzzyTermsByShortName = Map Name (Map Name [Either Name (NamedReference v Ann)])
forall k a. Map k a
Map.empty,
            $sel:topLevelComponents:Env :: Map Name (NamedReference v Ann)
topLevelComponents = Map Name (NamedReference v Ann)
forall k a. Map k a
Map.empty
          }
    ShouldUseTndr'Yes ParsingEnv m
parsingEnv -> do
      let resolveName :: Name -> Relation Name (ResolvesTo Referent)
          resolveName :: Name -> Relation Name (ResolvesTo Referent)
resolveName =
            Relation Name Referent
-> Set Name -> Name -> Relation Name (ResolvesTo Referent)
forall ref.
(Ord ref, Show ref) =>
Relation Name ref
-> Set Name -> Name -> Relation Name (ResolvesTo ref)
Names.resolveNameIncludingNames
              (Relation Name Referent
-> Relation Name Referent -> Relation Name Referent
forall a b.
(Ord a, Ord b) =>
Relation a b -> Relation a b -> Relation a b
Names.shadowing1 (Names -> Relation Name Referent
Names.terms (UnisonFile v -> Names
forall v a. Var v => UnisonFile v a -> Names
UF.toNames UnisonFile v
uf)) (Names -> Relation Name Referent
Names.terms (ParsingEnv m -> Names
forall (m :: * -> *). ParsingEnv m -> Names
Parser.names ParsingEnv m
parsingEnv)))
              Set Name
localNames

          localNames :: Set Name
localNames = (v -> Name) -> Set v -> Set Name
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map v -> Name
forall v. Var v => v -> Name
Name.unsafeParseVar (UnisonFile v -> Set v
forall v a. Var v => UnisonFile v a -> Set v
UF.toTermAndWatchNames UnisonFile v
uf)
          -- We exclude names from indirect dependencies for fuzzy searching during name resolution,
          -- that is dependencies under lib.*.lib for performance
          -- TODO: We may consider exposing user configuration to enable searching through indirect dependencies
          globalNamesShadowed :: Names
globalNamesShadowed = Names -> Names
excludeNamesFromIndirectDeps (Names -> Names) -> Names -> Names
forall a b. (a -> b) -> a -> b
$ Names -> Names -> Names
Names.shadowing (UnisonFile v -> Names
forall v a. Var v => UnisonFile v a -> Names
UF.toNames UnisonFile v
uf) (ParsingEnv m -> Names
forall (m :: * -> *). ParsingEnv m -> Names
Parser.names ParsingEnv m
parsingEnv)
            where
              excludeNamesFromIndirectDeps :: Names -> Names
excludeNamesFromIndirectDeps = (Name -> RedundantTypeAnnotation) -> Names -> Names
Names.filter (Name -> NameLocation
Name.classifyNameLocation (Name -> NameLocation)
-> (NameLocation -> RedundantTypeAnnotation)
-> Name
-> RedundantTypeAnnotation
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> NameLocation -> RedundantTypeAnnotation
excludeIndirectDeps)
              excludeIndirectDeps :: NameLocation -> RedundantTypeAnnotation
excludeIndirectDeps = (\case NameLocation
Name.NameLocation'IndirectDep -> RedundantTypeAnnotation
False; NameLocation
_otherwise -> RedundantTypeAnnotation
True)

          freeNames :: [Name]
          freeNames :: [Name]
freeNames =
            v -> Name
forall v. Var v => v -> Name
Name.unsafeParseVar (v -> Name) -> [v] -> [Name]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set v -> [v]
forall a. Set a -> [a]
Set.toList (Term' v v Ann -> Set v
forall vt v a. Term' vt v a -> Set v
Term.freeVars (Term' v v Ann -> Set v) -> Term' v v Ann -> Set v
forall a b. (a -> b) -> a -> b
$ UnisonFile v -> Term' v v Ann
forall v a. (Var v, Monoid a) => UnisonFile v a -> Term v a
UF.typecheckingTerm UnisonFile v
uf)

          possibleDepsExact :: [(Name, Name, ResolvesTo Referent)]
          possibleDepsExact :: [(Name, Name, ResolvesTo Referent)]
possibleDepsExact = do
            Name
freeName <- [Name]
freeNames
            (Name
name, ResolvesTo Referent
ref) <- Relation Name (ResolvesTo Referent)
-> [(Name, ResolvesTo Referent)]
forall a b. Relation a b -> [(a, b)]
Rel.toList (Name -> Relation Name (ResolvesTo Referent)
resolveName Name
freeName)
            [(Name
name, Name
freeName, ResolvesTo Referent
ref)]

          getFreeNameDepsFuzzy :: Name -> [(Name, Name, ResolvesTo Referent)]
          getFreeNameDepsFuzzy :: Name -> [(Name, Name, ResolvesTo Referent)]
getFreeNameDepsFuzzy Name
freeName = do
            let wantedTopNFuzzyMatches :: Int
wantedTopNFuzzyMatches = Int
3
            -- We use fuzzy matching by edit distance here because it is usually more appropriate
            -- than FZF-style fuzzy finding for offering suggestions for typos or other user errors.
            let fuzzyMatches :: [(Int, Name)]
fuzzyMatches =
                  Int -> [(Int, Name)] -> [(Int, Name)]
forall a. Int -> [a] -> [a]
take Int
wantedTopNFuzzyMatches ([(Int, Name)] -> [(Int, Name)]) -> [(Int, Name)] -> [(Int, Name)]
forall a b. (a -> b) -> a -> b
$
                    Names -> Set Name -> Name -> [(Int, Name)]
fuzzyFindByEditDistanceRanked Names
globalNamesShadowed Set Name
localNames Name
freeName

            let names :: [Name]
names = [(Int, Name)]
fuzzyMatches [(Int, Name)] -> Getting (Endo [Name]) [(Int, Name)] Name -> [Name]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. ((Int, Name) -> Const (Endo [Name]) (Int, Name))
-> [(Int, Name)] -> Const (Endo [Name]) [(Int, Name)]
forall s t a b. Each s t a b => Traversal s t a b
Traversal [(Int, Name)] [(Int, Name)] (Int, Name) (Int, Name)
each (((Int, Name) -> Const (Endo [Name]) (Int, Name))
 -> [(Int, Name)] -> Const (Endo [Name]) [(Int, Name)])
-> ((Name -> Const (Endo [Name]) Name)
    -> (Int, Name) -> Const (Endo [Name]) (Int, Name))
-> Getting (Endo [Name]) [(Int, Name)] Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name -> Const (Endo [Name]) Name)
-> (Int, Name) -> Const (Endo [Name]) (Int, Name)
forall s t a b. Field2 s t a b => Lens s t a b
Lens (Int, Name) (Int, Name) Name Name
_2
            let resolvedNames :: [(Name, ResolvesTo Referent)]
resolvedNames = Relation Name (ResolvesTo Referent)
-> [(Name, ResolvesTo Referent)]
forall a b. Relation a b -> [(a, b)]
Rel.toList (Relation Name (ResolvesTo Referent)
 -> [(Name, ResolvesTo Referent)])
-> (Name -> Relation Name (ResolvesTo Referent))
-> Name
-> [(Name, ResolvesTo Referent)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Relation Name (ResolvesTo Referent)
resolveName (Name -> [(Name, ResolvesTo Referent)])
-> [Name] -> [(Name, ResolvesTo Referent)]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [Name]
names
            let getShortName :: Name -> Name
getShortName Name
longname = HasCallStack => Text -> Name
Text -> Name
Name.unsafeParseText (NameSegment -> Text
NameSegment.toUnescapedText (NameSegment -> Text) -> NameSegment -> Text
forall a b. (a -> b) -> a -> b
$ Name -> NameSegment
Name.lastSegment Name
longname)

            ((Name, ResolvesTo Referent) -> (Name, Name, ResolvesTo Referent))
-> [(Name, ResolvesTo Referent)]
-> [(Name, Name, ResolvesTo Referent)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Name
longname, ResolvesTo Referent
ref) -> (Name
longname, Name -> Name
getShortName Name
longname, ResolvesTo Referent
ref)) [(Name, ResolvesTo Referent)]
resolvedNames

          freeNameDepsFuzzy :: Map Name [(Name, Name, ResolvesTo Referent)]
          freeNameDepsFuzzy :: Map Name [(Name, Name, ResolvesTo Referent)]
freeNameDepsFuzzy =
            [(Name, [(Name, Name, ResolvesTo Referent)])]
-> Map Name [(Name, Name, ResolvesTo Referent)]
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Name
freeName, Name -> [(Name, Name, ResolvesTo Referent)]
getFreeNameDepsFuzzy Name
freeName) | Name
freeName <- [Name]
freeNames]

          getPossibleRefs :: [(Name, Name, ResolvesTo Referent)] -> Defns (Set TermReference) (Set TypeReference)
          getPossibleRefs :: [(Name, Name, ResolvesTo Referent)]
-> DefnsF Set TermReference TermReference
getPossibleRefs =
            (DefnsF Set TermReference TermReference
 -> (Name, Name, ResolvesTo Referent)
 -> DefnsF Set TermReference TermReference)
-> DefnsF Set TermReference TermReference
-> [(Name, Name, ResolvesTo Referent)]
-> DefnsF Set TermReference TermReference
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl'
              ( \DefnsF Set TermReference TermReference
acc -> \case
                  (Name
_, Name
_, ResolvesToNamespace Referent
ref0) ->
                    case Referent
ref0 of
                      Referent.Con ConstructorReference
ref ConstructorType
_ -> DefnsF Set TermReference TermReference
acc DefnsF Set TermReference TermReference
-> (DefnsF Set TermReference TermReference
    -> DefnsF Set TermReference TermReference)
-> DefnsF Set TermReference TermReference
forall a b. a -> (a -> b) -> b
& ASetter
  (DefnsF Set TermReference TermReference)
  (DefnsF Set TermReference TermReference)
  (Set TermReference)
  (Set TermReference)
-> (Set TermReference -> Set TermReference)
-> DefnsF Set TermReference TermReference
-> DefnsF Set TermReference TermReference
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter
  (DefnsF Set TermReference TermReference)
  (DefnsF Set TermReference TermReference)
  (Set TermReference)
  (Set TermReference)
#types (TermReference -> Set TermReference -> Set TermReference
forall a. Ord a => a -> Set a -> Set a
Set.insert (ConstructorReference
ref ConstructorReference
-> Getting TermReference ConstructorReference TermReference
-> TermReference
forall s a. s -> Getting a s a -> a
^. Getting TermReference ConstructorReference TermReference
forall r s (f :: * -> *).
Functor f =>
(r -> f s)
-> GConstructorReference r -> f (GConstructorReference s)
ConstructorReference.reference_))
                      Referent.Ref TermReference
ref -> DefnsF Set TermReference TermReference
acc DefnsF Set TermReference TermReference
-> (DefnsF Set TermReference TermReference
    -> DefnsF Set TermReference TermReference)
-> DefnsF Set TermReference TermReference
forall a b. a -> (a -> b) -> b
& ASetter
  (DefnsF Set TermReference TermReference)
  (DefnsF Set TermReference TermReference)
  (Set TermReference)
  (Set TermReference)
-> (Set TermReference -> Set TermReference)
-> DefnsF Set TermReference TermReference
-> DefnsF Set TermReference TermReference
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter
  (DefnsF Set TermReference TermReference)
  (DefnsF Set TermReference TermReference)
  (Set TermReference)
  (Set TermReference)
#terms (TermReference -> Set TermReference -> Set TermReference
forall a. Ord a => a -> Set a -> Set a
Set.insert TermReference
ref)
                  (Name
_, Name
_, ResolvesToLocal Name
_) -> DefnsF Set TermReference TermReference
acc
              )
              (Set TermReference
-> Set TermReference -> DefnsF Set TermReference TermReference
forall terms types. terms -> types -> Defns terms types
Defns Set TermReference
forall a. Set a
Set.empty Set TermReference
forall a. Set a
Set.empty)

      TypeLookup v Ann
typeLookup <-
        (TypeLookup v Ann -> TypeLookup v Ann)
-> m (TypeLookup v Ann) -> m (TypeLookup v Ann)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
          (UnisonFile v -> TypeLookup v Ann
forall v a. Var v => UnisonFile v a -> TypeLookup v a
UF.declsToTypeLookup UnisonFile v
uf TypeLookup v Ann -> TypeLookup v Ann -> TypeLookup v Ann
forall a. Semigroup a => a -> a -> a
<>)
          ( DefnsF Set TermReference TermReference -> m (TypeLookup v Ann)
typeLookupf
              ( UnisonFile v -> DefnsF Set TermReference TermReference
forall a v.
(Monoid a, Var v) =>
UnisonFile v a -> DefnsF Set TermReference TermReference
UF.dependencies UnisonFile v
uf
                  DefnsF Set TermReference TermReference
-> DefnsF Set TermReference TermReference
-> DefnsF Set TermReference TermReference
forall a. Semigroup a => a -> a -> a
<> [(Name, Name, ResolvesTo Referent)]
-> DefnsF Set TermReference TermReference
getPossibleRefs [(Name, Name, ResolvesTo Referent)]
possibleDepsExact
                  DefnsF Set TermReference TermReference
-> DefnsF Set TermReference TermReference
-> DefnsF Set TermReference TermReference
forall a. Semigroup a => a -> a -> a
<> [(Name, Name, ResolvesTo Referent)]
-> DefnsF Set TermReference TermReference
getPossibleRefs ([[(Name, Name, ResolvesTo Referent)]]
-> [(Name, Name, ResolvesTo Referent)]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join ([[(Name, Name, ResolvesTo Referent)]]
 -> [(Name, Name, ResolvesTo Referent)])
-> [[(Name, Name, ResolvesTo Referent)]]
-> [(Name, Name, ResolvesTo Referent)]
forall a b. (a -> b) -> a -> b
$ Map Name [(Name, Name, ResolvesTo Referent)]
-> [[(Name, Name, ResolvesTo Referent)]]
forall k a. Map k a -> [a]
Map.elems Map Name [(Name, Name, ResolvesTo Referent)]
freeNameDepsFuzzy)
              )
          )

      let getTermsByShortname :: [(Name, Name, ResolvesTo Referent)] -> Map Name [Either Name (Typechecker.NamedReference v Ann)]
          getTermsByShortname :: [(Name, Name, ResolvesTo Referent)]
-> Map Name [Either Name (NamedReference v Ann)]
getTermsByShortname =
            (Map Name [Either Name (NamedReference v Ann)]
 -> (Name, Name, ResolvesTo Referent)
 -> Map Name [Either Name (NamedReference v Ann)])
-> Map Name [Either Name (NamedReference v Ann)]
-> [(Name, Name, ResolvesTo Referent)]
-> Map Name [Either Name (NamedReference v Ann)]
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl'
              ( \Map Name [Either Name (NamedReference v Ann)]
acc -> \case
                  (Name
name, Name
shortname, ResolvesToLocal Name
_) -> let v :: Either Name (NamedReference v Ann)
v = Name -> Either Name (NamedReference v Ann)
forall a b. a -> Either a b
Left Name
name in (Maybe [Either Name (NamedReference v Ann)]
 -> [Either Name (NamedReference v Ann)])
-> Name
-> Map Name [Either Name (NamedReference v Ann)]
-> Map Name [Either Name (NamedReference v Ann)]
forall k v. Ord k => (Maybe v -> v) -> k -> Map k v -> Map k v
Map.upsert ([Either Name (NamedReference v Ann)]
-> ([Either Name (NamedReference v Ann)]
    -> [Either Name (NamedReference v Ann)])
-> Maybe [Either Name (NamedReference v Ann)]
-> [Either Name (NamedReference v Ann)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Either Name (NamedReference v Ann)
v] (Either Name (NamedReference v Ann)
v Either Name (NamedReference v Ann)
-> [Either Name (NamedReference v Ann)]
-> [Either Name (NamedReference v Ann)]
forall a. a -> [a] -> [a]
:)) Name
shortname Map Name [Either Name (NamedReference v Ann)]
acc
                  (Name
name, Name
shortname, ResolvesToNamespace Referent
ref) ->
                    case TypeLookup v Ann -> Referent -> Maybe (Type v)
forall v a. TypeLookup v a -> Referent -> Maybe (Type v a)
TL.typeOfReferent TypeLookup v Ann
typeLookup Referent
ref of
                      Just Type v
ty ->
                        let v :: Either Name (NamedReference v Ann)
v = NamedReference v Ann -> Either Name (NamedReference v Ann)
forall a b. b -> Either a b
Right (Name -> Type v -> Replacement v -> NamedReference v Ann
forall v loc.
Name -> Type v loc -> Replacement v -> NamedReference v loc
Typechecker.NamedReference Name
name Type v
ty (Referent -> Replacement v
forall v. Referent -> Replacement v
Context.ReplacementRef Referent
ref))
                         in (Maybe [Either Name (NamedReference v Ann)]
 -> [Either Name (NamedReference v Ann)])
-> Name
-> Map Name [Either Name (NamedReference v Ann)]
-> Map Name [Either Name (NamedReference v Ann)]
forall k v. Ord k => (Maybe v -> v) -> k -> Map k v -> Map k v
Map.upsert ([Either Name (NamedReference v Ann)]
-> ([Either Name (NamedReference v Ann)]
    -> [Either Name (NamedReference v Ann)])
-> Maybe [Either Name (NamedReference v Ann)]
-> [Either Name (NamedReference v Ann)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Either Name (NamedReference v Ann)
v] (Either Name (NamedReference v Ann)
v Either Name (NamedReference v Ann)
-> [Either Name (NamedReference v Ann)]
-> [Either Name (NamedReference v Ann)]
forall a. a -> [a] -> [a]
:)) Name
shortname Map Name [Either Name (NamedReference v Ann)]
acc
                      Maybe (Type v)
Nothing -> Map Name [Either Name (NamedReference v Ann)]
acc
              )
              Map Name [Either Name (NamedReference v Ann)]
forall k a. Map k a
Map.empty

      let termsByShortname :: Map Name [Either Name (NamedReference v Ann)]
termsByShortname = [(Name, Name, ResolvesTo Referent)]
-> Map Name [Either Name (NamedReference v Ann)]
getTermsByShortname [(Name, Name, ResolvesTo Referent)]
possibleDepsExact
      let freeNameToFuzzyTermsByShortName :: Map Name (Map Name [Either Name (NamedReference v Ann)])
freeNameToFuzzyTermsByShortName = (Name
 -> [(Name, Name, ResolvesTo Referent)]
 -> Map Name [Either Name (NamedReference v Ann)])
-> Map Name [(Name, Name, ResolvesTo Referent)]
-> Map Name (Map Name [Either Name (NamedReference v Ann)])
forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey (\Name
_ [(Name, Name, ResolvesTo Referent)]
v -> [(Name, Name, ResolvesTo Referent)]
-> Map Name [Either Name (NamedReference v Ann)]
getTermsByShortname [(Name, Name, ResolvesTo Referent)]
v) Map Name [(Name, Name, ResolvesTo Referent)]
freeNameDepsFuzzy

      Env v Ann -> m (Env v Ann)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
        Typechecker.Env
          { [Type v]
ambientAbilities :: [Type v]
$sel:ambientAbilities:Env :: [Type v]
ambientAbilities,
            TypeLookup v Ann
$sel:typeLookup:Env :: TypeLookup v Ann
typeLookup :: TypeLookup v Ann
typeLookup,
            Map Name [Either Name (NamedReference v Ann)]
$sel:termsByShortname:Env :: Map Name [Either Name (NamedReference v Ann)]
termsByShortname :: Map Name [Either Name (NamedReference v Ann)]
termsByShortname,
            Map Name (Map Name [Either Name (NamedReference v Ann)])
$sel:freeNameToFuzzyTermsByShortName:Env :: Map Name (Map Name [Either Name (NamedReference v Ann)])
freeNameToFuzzyTermsByShortName :: Map Name (Map Name [Either Name (NamedReference v Ann)])
freeNameToFuzzyTermsByShortName,
            $sel:topLevelComponents:Env :: Map Name (NamedReference v Ann)
topLevelComponents = Map Name (NamedReference v Ann)
forall k a. Map k a
Map.empty
          }

-- | 'fuzzyFindByEditDistanceRanked' finds matches for the given 'name' within 'names' by edit distance.
--
-- Returns a list of 3-tuples composed of an edit-distance Score, a Name, and a List of term and type references.
--
-- Adapted from Unison.Server.Backend.fuzzyFind
--
-- TODO: Consider moving to Unison.Names
--
-- TODO: Take type similarity into account when ranking matches
fuzzyFindByEditDistanceRanked ::
  Names.Names ->
  Set Name ->
  Name ->
  [(Int, Name)]
fuzzyFindByEditDistanceRanked :: Names -> Set Name -> Name -> [(Int, Name)]
fuzzyFindByEditDistanceRanked Names
globalNames Set Name
localNames Name
name =
  let query :: String
query =
        (Text -> String
Text.unpack (Text -> String) -> (Name -> Text) -> Name -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Text
nameToText) Name
name

      -- Use 'nameToTextFromLastNSegments' so edit distance is not biased towards shorter fully-qualified names
      -- and the name being queried is only partially qualified.
      fzfGlobalNames :: [(Int, Name, Maybe (Set (Either Referent TermReference)))]
fzfGlobalNames =
        (Name -> Text)
-> String
-> Names
-> [(Int, Name, Maybe (Set (Either Referent TermReference)))]
Names.queryEditDistances Name -> Text
nameToTextFromLastNSegments String
query Names
globalNames
      fzfLocalNames :: [(Int, Name, Maybe (Set (Either Referent TermReference)))]
fzfLocalNames =
        (Name -> Text)
-> String
-> Set Name
-> [(Int, Name, Maybe (Set (Either Referent TermReference)))]
Names.queryEditDistances' Name -> Text
nameToTextFromLastNSegments String
query Set Name
localNames
      fzfNames :: [(Int, Name, Maybe (Set (Either Referent TermReference)))]
fzfNames = [(Int, Name, Maybe (Set (Either Referent TermReference)))]
fzfGlobalNames [(Int, Name, Maybe (Set (Either Referent TermReference)))]
-> [(Int, Name, Maybe (Set (Either Referent TermReference)))]
-> [(Int, Name, Maybe (Set (Either Referent TermReference)))]
forall a. [a] -> [a] -> [a]
++ [(Int, Name, Maybe (Set (Either Referent TermReference)))]
fzfLocalNames

      -- Keep only matches with a sufficiently low edit-distance score
      filterByScore :: [(Int, Name, Maybe (Set (Either Referent TermReference)))]
-> [(Int, Name, Maybe (Set (Either Referent TermReference)))]
filterByScore = ((Int, Name, Maybe (Set (Either Referent TermReference)))
 -> RedundantTypeAnnotation)
-> [(Int, Name, Maybe (Set (Either Referent TermReference)))]
-> [(Int, Name, Maybe (Set (Either Referent TermReference)))]
forall a. (a -> RedundantTypeAnnotation) -> [a] -> [a]
filter (\(Int
score, Name
_, Maybe (Set (Either Referent TermReference))
_) -> Int
score Int -> Int -> RedundantTypeAnnotation
forall a. Ord a => a -> a -> RedundantTypeAnnotation
< Int
maxScore)

      -- Prefer lower edit distances and then prefer shorter names by segment count
      rank :: (a, Name, c) -> (a, Int)
rank (a
score, Name
name, c
_) = (a
score, NonEmpty NameSegment -> Int
forall a. NonEmpty a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (NonEmpty NameSegment -> Int) -> NonEmpty NameSegment -> Int
forall a b. (a -> b) -> a -> b
$ Name -> NonEmpty NameSegment
Name.segments Name
name)

      -- Remove dupes based on refs
      dedupe :: [(a, b, Maybe (Set (Either Referent TermReference)))]
-> [(a, b, Maybe (Set (Either Referent TermReference)))]
dedupe =
        ((a, b, Maybe (Set (Either Referent TermReference)))
 -> Maybe (Set (Either Referent TermReference)))
-> [(a, b, Maybe (Set (Either Referent TermReference)))]
-> [(a, b, Maybe (Set (Either Referent TermReference)))]
forall (f :: * -> *) b a.
(Foldable f, Ord b) =>
(a -> b) -> f a -> [a]
List.nubOrdOn (\(a
_, b
_, Maybe (Set (Either Referent TermReference))
refs) -> Maybe (Set (Either Referent TermReference))
refs)

      dropRef :: [(a, b, c)] -> [(a, b)]
dropRef = ((a, b, c) -> (a, b)) -> [(a, b, c)] -> [(a, b)]
forall a b. (a -> b) -> [a] -> [b]
map (\(a
x, b
y, c
_) -> (a
x, b
y))

      refine :: [(Int, Name, Maybe (Set (Either Referent TermReference)))]
-> [(Int, Name)]
refine =
        [(Int, Name, Maybe (Set (Either Referent TermReference)))]
-> [(Int, Name)]
forall {a} {b} {c}. [(a, b, c)] -> [(a, b)]
dropRef ([(Int, Name, Maybe (Set (Either Referent TermReference)))]
 -> [(Int, Name)])
-> ([(Int, Name, Maybe (Set (Either Referent TermReference)))]
    -> [(Int, Name, Maybe (Set (Either Referent TermReference)))])
-> [(Int, Name, Maybe (Set (Either Referent TermReference)))]
-> [(Int, Name)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Int, Name, Maybe (Set (Either Referent TermReference)))]
-> [(Int, Name, Maybe (Set (Either Referent TermReference)))]
forall {a} {b}.
[(a, b, Maybe (Set (Either Referent TermReference)))]
-> [(a, b, Maybe (Set (Either Referent TermReference)))]
dedupe ([(Int, Name, Maybe (Set (Either Referent TermReference)))]
 -> [(Int, Name, Maybe (Set (Either Referent TermReference)))])
-> ([(Int, Name, Maybe (Set (Either Referent TermReference)))]
    -> [(Int, Name, Maybe (Set (Either Referent TermReference)))])
-> [(Int, Name, Maybe (Set (Either Referent TermReference)))]
-> [(Int, Name, Maybe (Set (Either Referent TermReference)))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, Name, Maybe (Set (Either Referent TermReference)))
 -> (Int, Int))
-> [(Int, Name, Maybe (Set (Either Referent TermReference)))]
-> [(Int, Name, Maybe (Set (Either Referent TermReference)))]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (Int, Name, Maybe (Set (Either Referent TermReference)))
-> (Int, Int)
forall {a} {c}. (a, Name, c) -> (a, Int)
rank ([(Int, Name, Maybe (Set (Either Referent TermReference)))]
 -> [(Int, Name, Maybe (Set (Either Referent TermReference)))])
-> ([(Int, Name, Maybe (Set (Either Referent TermReference)))]
    -> [(Int, Name, Maybe (Set (Either Referent TermReference)))])
-> [(Int, Name, Maybe (Set (Either Referent TermReference)))]
-> [(Int, Name, Maybe (Set (Either Referent TermReference)))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Int, Name, Maybe (Set (Either Referent TermReference)))]
-> [(Int, Name, Maybe (Set (Either Referent TermReference)))]
filterByScore
   in [(Int, Name, Maybe (Set (Either Referent TermReference)))]
-> [(Int, Name)]
refine [(Int, Name, Maybe (Set (Either Referent TermReference)))]
fzfNames
  where
    nNameSegments :: Int
nNameSegments = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ NonEmpty NameSegment -> Int
forall a. NonEmpty a -> Int
NonEmpty.length (NonEmpty NameSegment -> Int) -> NonEmpty NameSegment -> Int
forall a b. (a -> b) -> a -> b
$ Name -> NonEmpty NameSegment
Name.segments Name
name

    takeLast :: Int -> NonEmpty.NonEmpty a -> [a]
    takeLast :: forall a. Int -> NonEmpty a -> [a]
takeLast Int
n NonEmpty a
xs = Int -> NonEmpty a -> [a]
forall a. Int -> NonEmpty a -> [a]
NonEmpty.drop (NonEmpty a -> Int
forall a. NonEmpty a -> Int
NonEmpty.length NonEmpty a
xs Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n) NonEmpty a
xs
    nameFromLastNSegments :: Name -> Name
nameFromLastNSegments =
      NonEmpty NameSegment -> Name
Name.fromSegments
        (NonEmpty NameSegment -> Name)
-> (Name -> NonEmpty NameSegment) -> Name -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [NameSegment] -> NonEmpty NameSegment
forall a. HasCallStack => [a] -> NonEmpty a
NonEmpty.fromList
        ([NameSegment] -> NonEmpty NameSegment)
-> (Name -> [NameSegment]) -> Name -> NonEmpty NameSegment
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> NonEmpty NameSegment -> [NameSegment]
forall a. Int -> NonEmpty a -> [a]
takeLast Int
nNameSegments
        (NonEmpty NameSegment -> [NameSegment])
-> (Name -> NonEmpty NameSegment) -> Name -> [NameSegment]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> NonEmpty NameSegment
Name.segments

    -- Convert to lowercase for case-insensitive fuzzy matching
    nameToText :: Name -> Text
nameToText = Text -> Text
Text.toLower (Text -> Text) -> (Name -> Text) -> Name -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Text
Name.toText
    nameToTextFromLastNSegments :: Name -> Text
nameToTextFromLastNSegments = Name -> Text
nameToText (Name -> Text) -> (Name -> Name) -> Name -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Name
nameFromLastNSegments

    ceilingDiv :: Int -> Int -> Int
    ceilingDiv :: Int -> Int -> Int
ceilingDiv Int
x Int
y = (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
y
    -- Expect edit distances (number of typos) to be about half the length of the name being queried
    -- But clamp max edit distance to work well with very short names
    -- and keep ranking reasonably fast when a verbose name is queried
    maxScore :: Int
maxScore = (Int, Int) -> Int -> Int
forall a. Ord a => (a, a) -> a -> a
clamp (Int
3, Int
16) (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Text -> Int
Text.length (Name -> Text
nameToText Name
name) Int -> Int -> Int
`ceilingDiv` Int
2

synthesizeFile ::
  forall m v.
  (Monad m, Var v) =>
  Typechecker.Env v Ann ->
  UnisonFile v ->
  ResultT (Seq (Note v Ann)) m (UF.TypecheckedUnisonFile v Ann)
synthesizeFile :: forall (m :: * -> *) v.
(Monad m, Var v) =>
Env v Ann
-> UnisonFile v
-> ResultT (Seq (Note v Ann)) m (TypecheckedUnisonFile v Ann)
synthesizeFile Env v Ann
env0 UnisonFile v
uf = do
  let term :: Term v Ann
term = UnisonFile v -> Term v Ann
forall v a. (Var v, Monoid a) => UnisonFile v a -> Term v a
UF.typecheckingTerm UnisonFile v
uf
      -- substitute Blanks for any remaining free vars in UF body
      tdnrTerm :: Term v Ann
tdnrTerm = Term v Ann -> Term v Ann
forall v vt b ap.
Var v =>
Term (F vt b ap) v b -> Term (F vt b ap) v b
Term.prepareTDNR Term v Ann
term
      unisonFilePPE :: PrettyPrintEnv
unisonFilePPE = Namer -> Suffixifier -> PrettyPrintEnv
PPE.makePPE (Int -> Names -> Namer
PPE.hqNamer Int
10 (Names -> Names -> Names
Names.shadowing (UnisonFile v -> Names
forall v a. Var v => UnisonFile v a -> Names
UF.toNames UnisonFile v
uf) Names
Builtin.names)) Suffixifier
PPE.dontSuffixify
      Result Notes v Ann
notes Maybe (Type v Ann)
mayType =
        StateT (Term v Ann) (ResultT (Notes v Ann) Identity) (Type v Ann)
-> Term v Ann
-> MaybeT (WriterT (Notes v Ann) Identity) (Type v Ann)
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (PrettyPrintEnv
-> Env v Ann
-> StateT
     (Term v Ann) (ResultT (Notes v Ann) Identity) (Type v Ann)
forall (f :: * -> *) v loc.
(Monad f, Var v, Monoid loc, BuiltinAnnotation loc, Ord loc,
 Show loc) =>
PrettyPrintEnv -> Env v loc -> TDNR f v loc (Type v loc)
Typechecker.synthesizeAndResolve PrettyPrintEnv
unisonFilePPE Env v Ann
env0) Term v Ann
tdnrTerm
  -- If typechecking succeeded, reapply the TDNR decisions to user's term:
  Seq (Note v Ann)
-> Maybe (Type v Ann) -> ResultT (Seq (Note v Ann)) m (Type v Ann)
forall (m :: * -> *) notes a.
Applicative m =>
notes -> Maybe a -> ResultT notes m a
Result.makeResult (Notes v Ann -> Seq (Note v Ann)
forall v ann. Ord v => Notes v ann -> Seq (Note v ann)
convertNotes Notes v Ann
notes) Maybe (Type v Ann)
mayType ResultT (Seq (Note v Ann)) m (Type v Ann)
-> (Type v Ann
    -> ResultT (Seq (Note v Ann)) m (TypecheckedUnisonFile v Ann))
-> ResultT (Seq (Note v Ann)) m (TypecheckedUnisonFile v Ann)
forall a b.
MaybeT (WriterT (Seq (Note v Ann)) m) a
-> (a -> MaybeT (WriterT (Seq (Note v Ann)) m) b)
-> MaybeT (WriterT (Seq (Note v Ann)) m) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Type v Ann
_typ -> do
    let infos :: [InfoNote v Ann]
infos = Seq (InfoNote v Ann) -> [InfoNote v Ann]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList (Seq (InfoNote v Ann) -> [InfoNote v Ann])
-> Seq (InfoNote v Ann) -> [InfoNote v Ann]
forall a b. (a -> b) -> a -> b
$ Notes v Ann -> Seq (InfoNote v Ann)
forall v loc. Notes v loc -> Seq (InfoNote v loc)
Typechecker.infos Notes v Ann
notes
    ([[(v, Term v Ann, Type v Ann)]]
topLevelComponents :: [[(v, Term v, Type v)]]) <-
      let topLevelBindings :: Map v (Term v)
          topLevelBindings :: Map v (Term v Ann)
topLevelBindings = (v -> v) -> Map v (Term v Ann) -> Map v (Term v Ann)
forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeys v -> v
forall v. Var v => v -> v
Var.reset (Map v (Term v Ann) -> Map v (Term v Ann))
-> Map v (Term v Ann) -> Map v (Term v Ann)
forall a b. (a -> b) -> a -> b
$ Term v Ann -> Map v (Term v Ann)
forall a. Term v a -> Map v (Term v a)
extractTopLevelBindings Term v Ann
tdnrTerm
          extractTopLevelBindings :: (Term.Term v a -> Map v (Term.Term v a))
          extractTopLevelBindings :: forall a. Term v a -> Map v (Term v a)
extractTopLevelBindings (Term.LetRecNamedAnnotatedTop' RedundantTypeAnnotation
True a
_ [((a, v), Term v a)]
bs Term v a
body) =
            [(v, Term v a)] -> Map v (Term v a)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList (((a, v) -> v) -> ((a, v), Term v a) -> (v, Term v a)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (a, v) -> v
forall a b. (a, b) -> b
snd (((a, v), Term v a) -> (v, Term v a))
-> [((a, v), Term v a)] -> [(v, Term v a)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [((a, v), Term v a)]
bs) Map v (Term v a) -> Map v (Term v a) -> Map v (Term v a)
forall a. Semigroup a => a -> a -> a
<> Term v a -> Map v (Term v a)
forall a. Term v a -> Map v (Term v a)
extractTopLevelBindings Term v a
body
          extractTopLevelBindings Term v a
_ = Map v (Term v a)
forall k a. Map k a
Map.empty
          tlcsFromTypechecker :: [[(v, Type.Type v Ann, RedundantTypeAnnotation)]]
          tlcsFromTypechecker :: [[(v, Type v Ann, RedundantTypeAnnotation)]]
tlcsFromTypechecker =
            ([(v, Type v Ann, RedundantTypeAnnotation)] -> [v])
-> [[(v, Type v Ann, RedundantTypeAnnotation)]]
-> [[(v, Type v Ann, RedundantTypeAnnotation)]]
forall (f :: * -> *) b a.
(Foldable f, Ord b) =>
(a -> b) -> f a -> [a]
List.uniqueBy'
              (((v, Type v Ann, RedundantTypeAnnotation) -> v)
-> [(v, Type v Ann, RedundantTypeAnnotation)] -> [v]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (v, Type v Ann, RedundantTypeAnnotation) -> v
forall {a} {b} {c}. (a, b, c) -> a
vars)
              [[(v, Type v Ann, RedundantTypeAnnotation)]
t | Context.TopLevelComponent [(v, Type v Ann, RedundantTypeAnnotation)]
t <- [InfoNote v Ann]
infos]
            where
              vars :: (a, b, c) -> a
vars (a
v, b
_, c
_) = a
v
          addTypesToTopLevelBindings :: (v, c, c1) -> ResultT (Seq (Note v Ann)) m (v, Term v, c)
          addTypesToTopLevelBindings :: forall c c1.
(v, c, c1) -> ResultT (Seq (Note v Ann)) m (v, Term v Ann, c)
addTypesToTopLevelBindings (v
v, c
typ, c1
_redundant) = do
            Term v Ann
tm <- case v -> Map v (Term v Ann) -> Maybe (Term v Ann)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup v
v Map v (Term v Ann)
topLevelBindings of
              Maybe (Term v Ann)
Nothing -> CompilerBug v Ann
-> MaybeT (WriterT (Seq (Note v Ann)) m) (Term v Ann)
forall (f :: * -> *) v loc a.
Monad f =>
CompilerBug v loc -> ResultT (Seq (Note v loc)) f a
Result.compilerBug (CompilerBug v Ann
 -> MaybeT (WriterT (Seq (Note v Ann)) m) (Term v Ann))
-> CompilerBug v Ann
-> MaybeT (WriterT (Seq (Note v Ann)) m) (Term v Ann)
forall a b. (a -> b) -> a -> b
$ v -> Term v Ann -> CompilerBug v Ann
forall v loc. v -> Term v loc -> CompilerBug v loc
Result.TopLevelComponentNotFound v
v Term v Ann
term
              Just Term v Ann
x -> Term v Ann -> MaybeT (WriterT (Seq (Note v Ann)) m) (Term v Ann)
forall a. a -> MaybeT (WriterT (Seq (Note v Ann)) m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term v Ann
x
            -- The Var.reset removes any freshening added during typechecking
            pure (v -> v
forall v. Var v => v -> v
Var.reset v
v, Term v Ann
tm, c
typ)
       in ([(v, Type v Ann, RedundantTypeAnnotation)]
 -> MaybeT
      (WriterT (Seq (Note v Ann)) m) [(v, Term v Ann, Type v Ann)])
-> [[(v, Type v Ann, RedundantTypeAnnotation)]]
-> MaybeT
     (WriterT (Seq (Note v Ann)) m) [[(v, Term v Ann, Type v Ann)]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (((v, Type v Ann, RedundantTypeAnnotation)
 -> MaybeT
      (WriterT (Seq (Note v Ann)) m) (v, Term v Ann, Type v Ann))
-> [(v, Type v Ann, RedundantTypeAnnotation)]
-> MaybeT
     (WriterT (Seq (Note v Ann)) m) [(v, Term v Ann, Type v Ann)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (v, Type v Ann, RedundantTypeAnnotation)
-> MaybeT
     (WriterT (Seq (Note v Ann)) m) (v, Term v Ann, Type v Ann)
forall c c1.
(v, c, c1) -> ResultT (Seq (Note v Ann)) m (v, Term v Ann, c)
addTypesToTopLevelBindings) [[(v, Type v Ann, RedundantTypeAnnotation)]]
tlcsFromTypechecker
    let doTdnr :: Term v Ann -> Term v Ann
doTdnr = [InfoNote v Ann] -> Term v Ann -> Term v Ann
applyTdnrDecisions [InfoNote v Ann]
infos
    let doTdnrInComponent :: (v, Term v Ann, Type v Ann) -> (v, Term v Ann, Type v Ann)
doTdnrInComponent (v
v, Term v Ann
t, Type v Ann
tp) = (v
v, Term v Ann -> Term v Ann
doTdnr Term v Ann
t, Type v Ann
tp)
    let tdnredTlcs :: [[(v, Ann, Term v Ann, Type v Ann)]]
tdnredTlcs =
          [[(v, Term v Ann, Type v Ann)]]
topLevelComponents
            [[(v, Term v Ann, Type v Ann)]]
-> ([[(v, Term v Ann, Type v Ann)]]
    -> [[(v, Ann, Term v Ann, Type v Ann)]])
-> [[(v, Ann, Term v Ann, Type v Ann)]]
forall a b. a -> (a -> b) -> b
& (([(v, Term v Ann, Type v Ann)]
 -> [(v, Ann, Term v Ann, Type v Ann)])
-> [[(v, Term v Ann, Type v Ann)]]
-> [[(v, Ann, Term v Ann, Type v Ann)]]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([(v, Term v Ann, Type v Ann)]
  -> [(v, Ann, Term v Ann, Type v Ann)])
 -> [[(v, Term v Ann, Type v Ann)]]
 -> [[(v, Ann, Term v Ann, Type v Ann)]])
-> (((v, Term v Ann, Type v Ann)
     -> (v, Ann, Term v Ann, Type v Ann))
    -> [(v, Term v Ann, Type v Ann)]
    -> [(v, Ann, Term v Ann, Type v Ann)])
-> ((v, Term v Ann, Type v Ann)
    -> (v, Ann, Term v Ann, Type v Ann))
-> [[(v, Term v Ann, Type v Ann)]]
-> [[(v, Ann, Term v Ann, Type v Ann)]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((v, Term v Ann, Type v Ann) -> (v, Ann, Term v Ann, Type v Ann))
-> [(v, Term v Ann, Type v Ann)]
-> [(v, Ann, Term v Ann, Type v Ann)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap)
              ( \(v, Term v Ann, Type v Ann)
vtt ->
                  (v, Term v Ann, Type v Ann)
vtt
                    (v, Term v Ann, Type v Ann)
-> ((v, Term v Ann, Type v Ann) -> (v, Term v Ann, Type v Ann))
-> (v, Term v Ann, Type v Ann)
forall a b. a -> (a -> b) -> b
& (v, Term v Ann, Type v Ann) -> (v, Term v Ann, Type v Ann)
doTdnrInComponent
                    (v, Term v Ann, Type v Ann)
-> ((v, Term v Ann, Type v Ann)
    -> (v, Ann, Term v Ann, Type v Ann))
-> (v, Ann, Term v Ann, Type v Ann)
forall a b. a -> (a -> b) -> b
& \(v
v, Term v Ann
t, Type v Ann
tp) -> (v
v, Ann -> Maybe Ann -> Ann
forall a. a -> Maybe a -> a
fromMaybe (String -> Ann
forall a. HasCallStack => String -> a
error (String -> Ann) -> String -> Ann
forall a b. (a -> b) -> a -> b
$ String
"Symbol from typechecked file not present in parsed file" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> v -> String
forall a. Show a => a -> String
show v
v) (v -> UnisonFile v -> Maybe Ann
forall v a. Var v => v -> UnisonFile v a -> Maybe a
definitionLocation v
v UnisonFile v
uf), Term v Ann
t, Type v Ann
tp)
              )
    let ([[(v, Ann, Term v Ann, Type v Ann)]]
watches', [[(v, Ann, Term v Ann, Type v Ann)]]
terms') = ([(v, Ann, Term v Ann, Type v Ann)] -> RedundantTypeAnnotation)
-> [[(v, Ann, Term v Ann, Type v Ann)]]
-> ([[(v, Ann, Term v Ann, Type v Ann)]],
    [[(v, Ann, Term v Ann, Type v Ann)]])
forall a. (a -> RedundantTypeAnnotation) -> [a] -> ([a], [a])
partition [(v, Ann, Term v Ann, Type v Ann)] -> RedundantTypeAnnotation
isWatch [[(v, Ann, Term v Ann, Type v Ann)]]
tdnredTlcs
        isWatch :: [(v, Ann, Term v Ann, Type v Ann)] -> RedundantTypeAnnotation
isWatch = ((v, Ann, Term v Ann, Type v Ann) -> RedundantTypeAnnotation)
-> [(v, Ann, Term v Ann, Type v Ann)] -> RedundantTypeAnnotation
forall (t :: * -> *) a.
Foldable t =>
(a -> RedundantTypeAnnotation) -> t a -> RedundantTypeAnnotation
all (\(v
v, Ann
_, Term v Ann
_, Type v Ann
_) -> v -> Set v -> RedundantTypeAnnotation
forall a. Ord a => a -> Set a -> RedundantTypeAnnotation
Set.member v
v Set v
watchedVars)
        watchedVars :: Set v
watchedVars = [v] -> Set v
forall a. Ord a => [a] -> Set a
Set.fromList [v
v | (v
v, Ann
_a, Term v Ann
_) <- UnisonFile v -> [(v, Ann, Term v Ann)]
forall v a. UnisonFile v a -> [(v, a, Term v a)]
UF.allWatches UnisonFile v
uf]
        tlcKind :: [(v, Ann, Term v Ann, Type v Ann)]
-> (String, [(v, Ann, Term v Ann, Type v Ann)])
tlcKind [] = String -> (String, [(v, Ann, Term v Ann, Type v Ann)])
forall a. HasCallStack => String -> a
error String
"empty TLC, should never occur"
        tlcKind tlc :: [(v, Ann, Term v Ann, Type v Ann)]
tlc@((v
v, Ann
_, Term v Ann
_, Type v Ann
_) : [(v, Ann, Term v Ann, Type v Ann)]
_) =
          let hasE :: WatchKind -> Bool
              hasE :: String -> RedundantTypeAnnotation
hasE String
k = v -> [v] -> RedundantTypeAnnotation
forall a. Eq a => a -> [a] -> RedundantTypeAnnotation
forall (t :: * -> *) a.
(Foldable t, Eq a) =>
a -> t a -> RedundantTypeAnnotation
elem v
v ([v] -> RedundantTypeAnnotation)
-> ([(v, Ann, Term v Ann)] -> [v])
-> [(v, Ann, Term v Ann)]
-> RedundantTypeAnnotation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((v, Ann, Term v Ann) -> v) -> [(v, Ann, Term v Ann)] -> [v]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Getting v (v, Ann, Term v Ann) v -> (v, Ann, Term v Ann) -> v
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting v (v, Ann, Term v Ann) v
forall s t a b. Field1 s t a b => Lens s t a b
Lens (v, Ann, Term v Ann) (v, Ann, Term v Ann) v v
_1) ([(v, Ann, Term v Ann)] -> RedundantTypeAnnotation)
-> [(v, Ann, Term v Ann)] -> RedundantTypeAnnotation
forall a b. (a -> b) -> a -> b
$ [(v, Ann, Term v Ann)]
-> String
-> Map String [(v, Ann, Term v Ann)]
-> [(v, Ann, Term v Ann)]
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault [] String
k (UnisonFile v -> Map String [(v, Ann, Term v Ann)]
forall v a. UnisonFile v a -> Map String [(v, a, Term v a)]
UF.watches UnisonFile v
uf)
           in case (String -> RedundantTypeAnnotation) -> [String] -> Maybe String
forall (t :: * -> *) a.
Foldable t =>
(a -> RedundantTypeAnnotation) -> t a -> Maybe a
Foldable.find String -> RedundantTypeAnnotation
hasE (Map String [(v, Ann, Term v Ann)] -> [String]
forall k a. Map k a -> [k]
Map.keys (Map String [(v, Ann, Term v Ann)] -> [String])
-> Map String [(v, Ann, Term v Ann)] -> [String]
forall a b. (a -> b) -> a -> b
$ UnisonFile v -> Map String [(v, Ann, Term v Ann)]
forall v a. UnisonFile v a -> Map String [(v, a, Term v a)]
UF.watches UnisonFile v
uf) of
                Maybe String
Nothing -> String -> (String, [(v, Ann, Term v Ann, Type v Ann)])
forall a. HasCallStack => String -> a
error String
"wat"
                Just String
kind -> (String
kind, [(v, Ann, Term v Ann, Type v Ann)]
tlc)
    TypecheckedUnisonFile v Ann
-> ResultT (Seq (Note v Ann)) m (TypecheckedUnisonFile v Ann)
forall a. a -> MaybeT (WriterT (Seq (Note v Ann)) m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TypecheckedUnisonFile v Ann
 -> ResultT (Seq (Note v Ann)) m (TypecheckedUnisonFile v Ann))
-> TypecheckedUnisonFile v Ann
-> ResultT (Seq (Note v Ann)) m (TypecheckedUnisonFile v Ann)
forall a b. (a -> b) -> a -> b
$
      Map v (Id, DataDeclaration v Ann)
-> Map v (Id, EffectDeclaration v Ann)
-> [[(v, Ann, Term v Ann, Type v Ann)]]
-> [(String, [(v, Ann, Term v Ann, Type v Ann)])]
-> TypecheckedUnisonFile v Ann
forall v a.
Var v =>
Map v (Id, DataDeclaration v a)
-> Map v (Id, EffectDeclaration v a)
-> [[(v, a, Term v a, Type v a)]]
-> [(String, [(v, a, Term v a, Type v a)])]
-> TypecheckedUnisonFile v a
UF.typecheckedUnisonFile
        (UnisonFile v -> Map v (Id, DataDeclaration v Ann)
forall v a. UnisonFile v a -> Map v (Id, DataDeclaration v a)
UF.dataDeclarationsId UnisonFile v
uf)
        (UnisonFile v -> Map v (Id, EffectDeclaration v Ann)
forall v a. UnisonFile v a -> Map v (Id, EffectDeclaration v a)
UF.effectDeclarationsId UnisonFile v
uf)
        [[(v, Ann, Term v Ann, Type v Ann)]]
terms'
        (([(v, Ann, Term v Ann, Type v Ann)]
 -> (String, [(v, Ann, Term v Ann, Type v Ann)]))
-> [[(v, Ann, Term v Ann, Type v Ann)]]
-> [(String, [(v, Ann, Term v Ann, Type v Ann)])]
forall a b. (a -> b) -> [a] -> [b]
map [(v, Ann, Term v Ann, Type v Ann)]
-> (String, [(v, Ann, Term v Ann, Type v Ann)])
tlcKind [[(v, Ann, Term v Ann, Type v Ann)]]
watches')
  where
    applyTdnrDecisions ::
      [Context.InfoNote v Ann] ->
      Term v ->
      Term v
    applyTdnrDecisions :: [InfoNote v Ann] -> Term v Ann -> Term v Ann
applyTdnrDecisions [InfoNote v Ann]
infos Term v Ann
tdnrTerm = (Term v Ann -> Maybe (Term v Ann)) -> Term v Ann -> Term v Ann
forall (f :: * -> *) v a.
(Traversable f, Ord v) =>
(Term f v a -> Maybe (Term f v a)) -> Term f v a -> Term f v a
ABT.visitPure Term v Ann -> Maybe (Term v Ann)
resolve Term v Ann
tdnrTerm
      where
        decisions :: Map (String, Ann) (Term v Ann)
decisions = [((String, Ann), Term v Ann)] -> Map (String, Ann) (Term v Ann)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [((v -> String
forall v. Var v => v -> String
Var.nameStr v
v, Ann
loc), Term v Ann
replacement) | Context.Decision v
v Ann
loc Term v Ann
replacement <- [InfoNote v Ann]
infos]
        -- resolve (v,loc) in a matching Blank to whatever `fqn` maps to in `names`
        resolve :: Term v Ann -> Maybe (Term v Ann)
resolve Term v Ann
t = case Term v Ann
t of
          Term.Blank' (Blank.Recorded (Blank.Resolve Ann
loc' String
name))
            | Just Term v Ann
replacement <- (String, Ann)
-> Map (String, Ann) (Term v Ann) -> Maybe (Term v Ann)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (String
name, Ann
loc') Map (String, Ann) (Term v Ann)
decisions ->
                -- loc of replacement already chosen correctly by whatever made the
                -- Decision
                Term v Ann -> Maybe (Term v Ann)
forall a. a -> Maybe a
Just (Term v Ann -> Maybe (Term v Ann))
-> Term v Ann -> Maybe (Term v Ann)
forall a b. (a -> b) -> a -> b
$ Term v Ann
replacement
          Term v Ann
_ -> Maybe (Term v Ann)
forall a. Maybe a
Nothing