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 List.NonEmpty
import Data.Map qualified as Map
import Data.Sequence qualified as Seq
import Data.Set qualified as Set
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 qualified as Name
import Unison.Names qualified as Names
import Unison.Parser.Ann (Ann)
import Unison.Prelude
import Unison.PrettyPrintEnv.Names qualified as PPE
import Unison.Reference (TermReference, TypeReference)
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 (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.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
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
data ShouldUseTndr m
= ShouldUseTndr'No
| ShouldUseTndr'Yes (Parser.ParsingEnv m)
computeTypecheckingEnvironment ::
(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 v (m :: * -> *).
(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 [NamedReference v Ann]
termsByShortname = Map Name [NamedReference v Ann]
forall k a. Map k a
Map.empty
}
ShouldUseTndr'Yes ParsingEnv m
parsingEnv -> do
let preexistingNames :: Names
preexistingNames = ParsingEnv m -> Names
forall (m :: * -> *). ParsingEnv m -> Names
Parser.names ParsingEnv m
parsingEnv
tm :: Term v Ann
tm = UnisonFile v -> Term v Ann
forall v a. (Var v, Monoid a) => UnisonFile v a -> Term v a
UF.typecheckingTerm UnisonFile v
uf
possibleDeps :: [(Name, Name, Referent)]
possibleDeps =
[ (Name
name, Name
shortname, Referent
r)
| (Name
name, Referent
r) <- Relation Name Referent -> [(Name, Referent)]
forall a b. Relation a b -> [(a, b)]
Rel.toList (Names -> Relation Name Referent
Names.terms Names
preexistingNames),
v
v <- Set v -> [v]
forall a. Set a -> [a]
Set.toList (Term v Ann -> Set v
forall vt v a. Term' vt v a -> Set v
Term.freeVars Term v Ann
tm),
let shortname :: Name
shortname = v -> Name
forall v. Var v => v -> Name
Name.unsafeParseVar v
v,
Name
name Name -> [NameSegment] -> RedundantTypeAnnotation
`Name.endsWithReverseSegments` NonEmpty NameSegment -> [NameSegment]
forall a. NonEmpty a -> [a]
List.NonEmpty.toList (Name -> NonEmpty NameSegment
Name.reverseSegments Name
shortname)
]
possibleRefs :: DefnsF Set TermReference TermReference
possibleRefs =
(DefnsF Set TermReference TermReference
-> (Name, Name, Referent)
-> DefnsF Set TermReference TermReference)
-> DefnsF Set TermReference TermReference
-> [(Name, Name, 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
_, 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_))
(Name
_, Name
_, 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)
)
(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)
[(Name, Name, Referent)]
possibleDeps
TypeLookup v Ann
tl <- (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
<> DefnsF Set TermReference TermReference
possibleRefs))
let fqnsByShortName :: Map Name [NamedReference v Ann]
fqnsByShortName =
[(Name, NamedReference v Ann)] -> Map Name [NamedReference v Ann]
forall (f :: * -> *) k v.
(Foldable f, Ord k) =>
f (k, v) -> Map k [v]
List.multimap ([(Name, NamedReference v Ann)] -> Map Name [NamedReference v Ann])
-> [(Name, NamedReference v Ann)]
-> Map Name [NamedReference v Ann]
forall a b. (a -> b) -> a -> b
$
[ (Name
shortname, NamedReference v Ann
nr)
| (Name
name, Name
shortname, Referent
r) <- [(Name, Name, Referent)]
possibleDeps,
Type v
typ <- Maybe (Type v) -> [Type v]
forall a. Maybe a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Maybe (Type v) -> [Type v]) -> Maybe (Type v) -> [Type v]
forall a b. (a -> b) -> a -> b
$ TypeLookup v Ann -> Referent -> Maybe (Type v)
forall v a. TypeLookup v a -> Referent -> Maybe (Type v a)
TL.typeOfReferent TypeLookup v Ann
tl Referent
r,
let nr :: NamedReference v Ann
nr = 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
typ (Referent -> Replacement v
forall v. Referent -> Replacement v
Context.ReplacementRef Referent
r)
]
[(Name, NamedReference v Ann)]
-> [(Name, NamedReference v Ann)] -> [(Name, NamedReference v Ann)]
forall a. Semigroup a => a -> a -> a
<>
[ (Name
shortname, NamedReference v Ann
nr)
| (Name
name, Referent
r) <- Relation Name Referent -> [(Name, Referent)]
forall a b. Relation a b -> [(a, b)]
Rel.toList (Names -> Relation Name Referent
Names.terms (Names -> Relation Name Referent)
-> Names -> Relation Name Referent
forall a b. (a -> b) -> a -> b
$ UnisonFile v -> Names
forall v a. Var v => UnisonFile v a -> Names
UF.toNames UnisonFile v
uf),
v
v <- Set v -> [v]
forall a. Set a -> [a]
Set.toList (Term v Ann -> Set v
forall vt v a. Term' vt v a -> Set v
Term.freeVars Term v Ann
tm),
let shortname :: Name
shortname = v -> Name
forall v. Var v => v -> Name
Name.unsafeParseVar v
v,
Name
name Name -> [NameSegment] -> RedundantTypeAnnotation
`Name.endsWithReverseSegments` NonEmpty NameSegment -> [NameSegment]
forall a. NonEmpty a -> [a]
List.NonEmpty.toList (Name -> NonEmpty NameSegment
Name.reverseSegments Name
shortname),
Type v
typ <- Maybe (Type v) -> [Type v]
forall a. Maybe a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Maybe (Type v) -> [Type v]) -> Maybe (Type v) -> [Type v]
forall a b. (a -> b) -> a -> b
$ TypeLookup v Ann -> Referent -> Maybe (Type v)
forall v a. TypeLookup v a -> Referent -> Maybe (Type v a)
TL.typeOfReferent TypeLookup v Ann
tl Referent
r,
let nr :: NamedReference v Ann
nr = 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
typ (Referent -> Replacement v
forall v. Referent -> Replacement v
Context.ReplacementRef Referent
r)
]
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,
$sel:typeLookup:Env :: TypeLookup v Ann
typeLookup = TypeLookup v Ann
tl,
$sel:termsByShortname:Env :: Map Name [NamedReference v Ann]
termsByShortname = Map Name [NamedReference v Ann]
fqnsByShortName
}
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
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
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
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 :: 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 ->
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