module Unison.UnisonFile.Names
  ( addNamesFromTypeCheckedUnisonFile,
    environmentFor,
    toNames,
    toTermAndWatchNames,
    typecheckedToNames,
  )
where

import Control.Lens (_1)
import Data.Map qualified as Map
import Data.Set qualified as Set
import Unison.ABT qualified as ABT
import Unison.DataDeclaration (DataDeclaration, EffectDeclaration (..))
import Unison.DataDeclaration qualified as DD
import Unison.DataDeclaration.Names qualified as DD.Names
import Unison.Hashing.V2.Convert qualified as Hashing
import Unison.Names (Names (..))
import Unison.Names qualified as Names
import Unison.Names.ResolutionResult qualified as Names
import Unison.Prelude
import Unison.Reference qualified as Reference
import Unison.Referent qualified as Referent
import Unison.Syntax.Name qualified as Name
import Unison.UnisonFile qualified as UF
import Unison.UnisonFile.Env (Env (..))
import Unison.UnisonFile.Error (Error (DupDataAndAbility, UnknownType))
import Unison.UnisonFile.Type (TypecheckedUnisonFile, UnisonFile)
import Unison.Util.Relation qualified as Relation
import Unison.Var (Var)
import Unison.WatchKind qualified as WK

toNames :: (Var v) => UnisonFile v a -> Names
toNames :: forall v a. Var v => UnisonFile v a -> Names
toNames UnisonFile v a
uf = Names
datas Names -> Names -> Names
forall a. Semigroup a => a -> a -> a
<> Names
effects
  where
    datas :: Names
datas = ((v, (Id, DataDeclaration v a)) -> Names)
-> [(v, (Id, DataDeclaration v a))] -> Names
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((v -> Name) -> (v, (Id, DataDeclaration v a)) -> Names
forall v a.
Var v =>
(v -> Name) -> (v, (Id, DataDeclaration v a)) -> Names
DD.Names.dataDeclToNames' v -> Name
forall v. Var v => v -> Name
Name.unsafeParseVar) (Map v (Id, DataDeclaration v a) -> [(v, (Id, DataDeclaration v a))]
forall k a. Map k a -> [(k, a)]
Map.toList (UnisonFile v a -> Map v (Id, DataDeclaration v a)
forall v a. UnisonFile v a -> Map v (Id, DataDeclaration v a)
UF.dataDeclarationsId UnisonFile v a
uf))
    effects :: Names
effects = ((v, (Id, EffectDeclaration v a)) -> Names)
-> [(v, (Id, EffectDeclaration v a))] -> Names
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((v -> Name) -> (v, (Id, EffectDeclaration v a)) -> Names
forall v a.
Var v =>
(v -> Name) -> (v, (Id, EffectDeclaration v a)) -> Names
DD.Names.effectDeclToNames' v -> Name
forall v. Var v => v -> Name
Name.unsafeParseVar) (Map v (Id, EffectDeclaration v a)
-> [(v, (Id, EffectDeclaration v a))]
forall k a. Map k a -> [(k, a)]
Map.toList (UnisonFile v a -> Map v (Id, EffectDeclaration v a)
forall v a. UnisonFile v a -> Map v (Id, EffectDeclaration v a)
UF.effectDeclarationsId UnisonFile v a
uf))

-- | The set of all term and test watch names. No constructors.
toTermAndWatchNames :: (Var v) => UnisonFile v a -> Set v
toTermAndWatchNames :: forall v a. Var v => UnisonFile v a -> Set v
toTermAndWatchNames UnisonFile v a
uf =
  Map v (a, Term v a) -> Set v
forall k a. Map k a -> Set k
Map.keysSet UnisonFile v a
uf.terms
    Set v -> Set v -> Set v
forall a. Semigroup a => a -> a -> a
<> ((WatchKind, [(v, a, Term v a)]) -> Set v)
-> [(WatchKind, [(v, a, Term v a)])] -> Set v
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap
      ( \case
          (WatchKind
WK.TestWatch, [(v, a, Term v a)]
xs) -> [v] -> Set v
forall a. Ord a => [a] -> Set a
Set.fromList (((v, a, Term v a) -> v) -> [(v, a, Term v a)] -> [v]
forall a b. (a -> b) -> [a] -> [b]
map (Getting v (v, a, Term v a) v -> (v, a, Term v a) -> v
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting v (v, a, Term v a) v
forall s t a b. Field1 s t a b => Lens s t a b
Lens (v, a, Term v a) (v, a, Term v a) v v
_1) [(v, a, Term v a)]
xs)
          (WatchKind, [(v, a, Term v a)])
_ -> Set v
forall a. Set a
Set.empty
      )
      (Map WatchKind [(v, a, Term v a)]
-> [(WatchKind, [(v, a, Term v a)])]
forall k a. Map k a -> [(k, a)]
Map.toList UnisonFile v a
uf.watches)

typecheckedToNames :: (Var v) => TypecheckedUnisonFile v a -> Names
typecheckedToNames :: forall v a. Var v => TypecheckedUnisonFile v a -> Names
typecheckedToNames TypecheckedUnisonFile v a
uf = Relation Name (Referent' (Reference' Text Hash))
-> Relation Name (Reference' Text Hash) -> Names
Names (Relation Name (Referent' (Reference' Text Hash))
terms Relation Name (Referent' (Reference' Text Hash))
-> Relation Name (Referent' (Reference' Text Hash))
-> Relation Name (Referent' (Reference' Text Hash))
forall a. Semigroup a => a -> a -> a
<> Relation Name (Referent' (Reference' Text Hash))
ctors) Relation Name (Reference' Text Hash)
types
  where
    terms :: Relation Name (Referent' (Reference' Text Hash))
terms =
      [(Name, Referent' (Reference' Text Hash))]
-> Relation Name (Referent' (Reference' Text Hash))
forall a b. (Ord a, Ord b) => [(a, b)] -> Relation a b
Relation.fromList
        [ (v -> Name
forall v. Var v => v -> Name
Name.unsafeParseVar v
v, Reference' Text Hash -> Referent' (Reference' Text Hash)
Referent.Ref Reference' Text Hash
r)
          | (v
v, (a
_a, Reference' Text Hash
r, Maybe WatchKind
wk, Term v a
_, Type v a
_)) <- Map
  v (a, Reference' Text Hash, Maybe WatchKind, Term v a, Type v a)
-> [(v,
     (a, Reference' Text Hash, Maybe WatchKind, Term v a, Type v a))]
forall k a. Map k a -> [(k, a)]
Map.toList (Map
   v (a, Reference' Text Hash, Maybe WatchKind, Term v a, Type v a)
 -> [(v,
      (a, Reference' Text Hash, Maybe WatchKind, Term v a, Type v a))])
-> Map
     v (a, Reference' Text Hash, Maybe WatchKind, Term v a, Type v a)
-> [(v,
     (a, Reference' Text Hash, Maybe WatchKind, Term v a, Type v a))]
forall a b. (a -> b) -> a -> b
$ TypecheckedUnisonFile v a
-> Map
     v (a, Reference' Text Hash, Maybe WatchKind, Term v a, Type v a)
forall v a.
TypecheckedUnisonFile v a
-> Map
     v (a, Reference' Text Hash, Maybe WatchKind, Term v a, Type v a)
UF.hashTerms TypecheckedUnisonFile v a
uf,
            Maybe WatchKind
wk Maybe WatchKind -> Maybe WatchKind -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe WatchKind
forall a. Maybe a
Nothing Bool -> Bool -> Bool
|| Maybe WatchKind
wk Maybe WatchKind -> Maybe WatchKind -> Bool
forall a. Eq a => a -> a -> Bool
== WatchKind -> Maybe WatchKind
forall a. a -> Maybe a
Just WatchKind
forall a. (Eq a, IsString a) => a
WK.TestWatch
        ]
    types :: Relation Name (Reference' Text Hash)
types =
      [(Name, Reference' Text Hash)]
-> Relation Name (Reference' Text Hash)
forall a b. (Ord a, Ord b) => [(a, b)] -> Relation a b
Relation.fromList
        [ (v -> Name
forall v. Var v => v -> Name
Name.unsafeParseVar v
v, Reference' Text Hash
r)
          | (v
v, Reference' Text Hash
r) <-
              Map v (Reference' Text Hash) -> [(v, Reference' Text Hash)]
forall k a. Map k a -> [(k, a)]
Map.toList (Map v (Reference' Text Hash) -> [(v, Reference' Text Hash)])
-> Map v (Reference' Text Hash) -> [(v, Reference' Text Hash)]
forall a b. (a -> b) -> a -> b
$
                ((Reference' Text Hash, DataDeclaration v a)
 -> Reference' Text Hash)
-> Map v (Reference' Text Hash, DataDeclaration v a)
-> Map v (Reference' Text Hash)
forall a b. (a -> b) -> Map v a -> Map v b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Reference' Text Hash, DataDeclaration v a) -> Reference' Text Hash
forall a b. (a, b) -> a
fst (TypecheckedUnisonFile v a
-> Map v (Reference' Text Hash, DataDeclaration v a)
forall v a.
TypecheckedUnisonFile v a
-> Map v (Reference' Text Hash, DataDeclaration v a)
UF.dataDeclarations' TypecheckedUnisonFile v a
uf)
                  Map v (Reference' Text Hash)
-> Map v (Reference' Text Hash) -> Map v (Reference' Text Hash)
forall a. Semigroup a => a -> a -> a
<> ((Reference' Text Hash, EffectDeclaration v a)
 -> Reference' Text Hash)
-> Map v (Reference' Text Hash, EffectDeclaration v a)
-> Map v (Reference' Text Hash)
forall a b. (a -> b) -> Map v a -> Map v b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Reference' Text Hash, EffectDeclaration v a)
-> Reference' Text Hash
forall a b. (a, b) -> a
fst (TypecheckedUnisonFile v a
-> Map v (Reference' Text Hash, EffectDeclaration v a)
forall v a.
TypecheckedUnisonFile v a
-> Map v (Reference' Text Hash, EffectDeclaration v a)
UF.effectDeclarations' TypecheckedUnisonFile v a
uf)
        ]
    ctors :: Relation Name (Referent' (Reference' Text Hash))
ctors =
      Map Name (Referent' (Reference' Text Hash))
-> Relation Name (Referent' (Reference' Text Hash))
forall a b. (Ord a, Ord b) => Map a b -> Relation a b
Relation.fromMap
        (Map Name (Referent' (Reference' Text Hash))
 -> Relation Name (Referent' (Reference' Text Hash)))
-> (TypecheckedUnisonFile v a
    -> Map Name (Referent' (Reference' Text Hash)))
-> TypecheckedUnisonFile v a
-> Relation Name (Referent' (Reference' Text Hash))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (v -> Name)
-> Map v (Referent' (Reference' Text Hash))
-> Map Name (Referent' (Reference' Text Hash))
forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeys v -> Name
forall v. Var v => v -> Name
Name.unsafeParseVar
        (Map v (Referent' (Reference' Text Hash))
 -> Map Name (Referent' (Reference' Text Hash)))
-> (TypecheckedUnisonFile v a
    -> Map v (Referent' (Reference' Text Hash)))
-> TypecheckedUnisonFile v a
-> Map Name (Referent' (Reference' Text Hash))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Referent' Id -> Referent' (Reference' Text Hash))
-> Map v (Referent' Id) -> Map v (Referent' (Reference' Text Hash))
forall a b. (a -> b) -> Map v a -> Map v b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Id -> Reference' Text Hash)
-> Referent' Id -> Referent' (Reference' Text Hash)
forall a b. (a -> b) -> Referent' a -> Referent' b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Id -> Reference' Text Hash
forall h t. Id' h -> Reference' t h
Reference.DerivedId)
        (Map v (Referent' Id) -> Map v (Referent' (Reference' Text Hash)))
-> (TypecheckedUnisonFile v a -> Map v (Referent' Id))
-> TypecheckedUnisonFile v a
-> Map v (Referent' (Reference' Text Hash))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypecheckedUnisonFile v a -> Map v (Referent' Id)
forall v a.
Ord v =>
TypecheckedUnisonFile v a -> Map v (Referent' Id)
UF.hashConstructors
        (TypecheckedUnisonFile v a
 -> Relation Name (Referent' (Reference' Text Hash)))
-> TypecheckedUnisonFile v a
-> Relation Name (Referent' (Reference' Text Hash))
forall a b. (a -> b) -> a -> b
$ TypecheckedUnisonFile v a
uf

addNamesFromTypeCheckedUnisonFile :: (Var v) => TypecheckedUnisonFile v a -> Names -> Names
addNamesFromTypeCheckedUnisonFile :: forall v a. Var v => TypecheckedUnisonFile v a -> Names -> Names
addNamesFromTypeCheckedUnisonFile TypecheckedUnisonFile v a
unisonFile Names
names = Names -> Names -> Names
Names.shadowing (TypecheckedUnisonFile v a -> Names
forall v a. Var v => TypecheckedUnisonFile v a -> Names
typecheckedToNames TypecheckedUnisonFile v a
unisonFile) Names
names

-- This function computes hashes for data and effect declarations, and
-- also returns a function for resolving strings to (Reference, ConstructorId)
-- for parsing of pattern matching
--
-- If there are duplicate declarations, the duplicated names are returned on the
-- left.
environmentFor ::
  forall v a.
  (Var v) =>
  Names ->
  Map v (DataDeclaration v a) ->
  Map v (EffectDeclaration v a) ->
  Names.ResolutionResult a (Either [Error v a] (Env v a))
environmentFor :: forall v a.
Var v =>
Names
-> Map v (DataDeclaration v a)
-> Map v (EffectDeclaration v a)
-> ResolutionResult a (Either [Error v a] (Env v a))
environmentFor Names
names Map v (DataDeclaration v a)
dataDecls0 Map v (EffectDeclaration v a)
effectDecls0 = do
  let locallyBoundTypes :: Set v
locallyBoundTypes = Map v (DataDeclaration v a) -> Set v
forall k a. Map k a -> Set k
Map.keysSet Map v (DataDeclaration v a)
dataDecls0 Set v -> Set v -> Set v
forall a. Semigroup a => a -> a -> a
<> Map v (EffectDeclaration v a) -> Set v
forall k a. Map k a -> Set k
Map.keysSet Map v (EffectDeclaration v a)
effectDecls0

  -- data decls and effect decls may reference each other, and thus must be hashed together
  Map v (DataDeclaration v a)
dataDecls :: Map v (DataDeclaration v a) <-
    (DataDeclaration v a
 -> Either (Seq (ResolutionFailure a)) (DataDeclaration v a))
-> Map v (DataDeclaration v a)
-> Either (Seq (ResolutionFailure a)) (Map v (DataDeclaration v a))
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) -> Map v a -> f (Map v b)
traverse ((v -> Name)
-> (Name -> v)
-> Set v
-> Names
-> DataDeclaration v a
-> Either (Seq (ResolutionFailure a)) (DataDeclaration v a)
forall v a.
Var v =>
(v -> Name)
-> (Name -> v)
-> Set v
-> Names
-> DataDeclaration v a
-> ResolutionResult a (DataDeclaration v a)
DD.Names.bindNames v -> Name
forall v. Var v => v -> Name
Name.unsafeParseVar Name -> v
forall v. Var v => Name -> v
Name.toVar Set v
locallyBoundTypes Names
names) Map v (DataDeclaration v a)
dataDecls0
  Map v (EffectDeclaration v a)
effectDecls :: Map v (EffectDeclaration v a) <-
    (EffectDeclaration v a
 -> Either (Seq (ResolutionFailure a)) (EffectDeclaration v a))
-> Map v (EffectDeclaration v a)
-> Either
     (Seq (ResolutionFailure a)) (Map v (EffectDeclaration v a))
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) -> Map v a -> f (Map v b)
traverse ((DataDeclaration v a
 -> Either (Seq (ResolutionFailure a)) (DataDeclaration v a))
-> EffectDeclaration v a
-> Either (Seq (ResolutionFailure a)) (EffectDeclaration v a)
forall (f :: * -> *) v a v' a'.
Functor f =>
(DataDeclaration v a -> f (DataDeclaration v' a'))
-> EffectDeclaration v a -> f (EffectDeclaration v' a')
DD.withEffectDeclM ((v -> Name)
-> (Name -> v)
-> Set v
-> Names
-> DataDeclaration v a
-> Either (Seq (ResolutionFailure a)) (DataDeclaration v a)
forall v a.
Var v =>
(v -> Name)
-> (Name -> v)
-> Set v
-> Names
-> DataDeclaration v a
-> ResolutionResult a (DataDeclaration v a)
DD.Names.bindNames v -> Name
forall v. Var v => v -> Name
Name.unsafeParseVar Name -> v
forall v. Var v => Name -> v
Name.toVar Set v
locallyBoundTypes Names
names)) Map v (EffectDeclaration v a)
effectDecls0

  let allDecls0 :: Map v (DataDeclaration v a)
      allDecls0 :: Map v (DataDeclaration v a)
allDecls0 = Map v (DataDeclaration v a)
-> Map v (DataDeclaration v a) -> Map v (DataDeclaration v a)
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union Map v (DataDeclaration v a)
dataDecls (EffectDeclaration v a -> DataDeclaration v a
forall v a. EffectDeclaration v a -> DataDeclaration v a
toDataDecl (EffectDeclaration v a -> DataDeclaration v a)
-> Map v (EffectDeclaration v a) -> Map v (DataDeclaration v a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map v (EffectDeclaration v a)
effectDecls)
  [(v, Id, DataDeclaration v a)]
hashDecls' :: [(v, Reference.Id, DataDeclaration v a)] <- Map v (DataDeclaration v a)
-> ResolutionResult a [(v, Id, DataDeclaration v a)]
forall v a.
Var v =>
Map v (DataDeclaration v a)
-> ResolutionResult a [(v, Id, DataDeclaration v a)]
Hashing.hashDataDecls Map v (DataDeclaration v a)
allDecls0
  -- then we have to pick out the dataDecls from the effectDecls
  let allDecls :: Map v (Id, DataDeclaration v a)
allDecls = [(v, (Id, DataDeclaration v a))] -> Map v (Id, DataDeclaration v a)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(v
v, (Id
r, DataDeclaration v a
de)) | (v
v, Id
r, DataDeclaration v a
de) <- [(v, Id, DataDeclaration v a)]
hashDecls']
      dataDecls' :: Map v (Id, DataDeclaration v a)
dataDecls' = Map v (Id, DataDeclaration v a)
-> Map v (EffectDeclaration v a) -> Map v (Id, DataDeclaration v a)
forall k a b. Ord k => Map k a -> Map k b -> Map k a
Map.difference Map v (Id, DataDeclaration v a)
allDecls Map v (EffectDeclaration v a)
effectDecls
      effectDecls' :: Map v (Id, EffectDeclaration v a)
effectDecls' = (DataDeclaration v a -> EffectDeclaration v a)
-> (Id, DataDeclaration v a) -> (Id, EffectDeclaration v a)
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second DataDeclaration v a -> EffectDeclaration v a
forall v a. DataDeclaration v a -> EffectDeclaration v a
EffectDeclaration ((Id, DataDeclaration v a) -> (Id, EffectDeclaration v a))
-> Map v (Id, DataDeclaration v a)
-> Map v (Id, EffectDeclaration v a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map v (Id, DataDeclaration v a)
-> Map v (DataDeclaration v a) -> Map v (Id, DataDeclaration v a)
forall k a b. Ord k => Map k a -> Map k b -> Map k a
Map.difference Map v (Id, DataDeclaration v a)
allDecls Map v (DataDeclaration v a)
dataDecls
      -- ctor and effect terms
      ctors :: Names
ctors = ((v, (Id, DataDeclaration v a)) -> Names)
-> [(v, (Id, DataDeclaration v a))] -> Names
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((v -> Name) -> (v, (Id, DataDeclaration v a)) -> Names
forall v a.
Var v =>
(v -> Name) -> (v, (Id, DataDeclaration v a)) -> Names
DD.Names.dataDeclToNames' v -> Name
forall v. Var v => v -> Name
Name.unsafeParseVar) (Map v (Id, DataDeclaration v a) -> [(v, (Id, DataDeclaration v a))]
forall k a. Map k a -> [(k, a)]
Map.toList Map v (Id, DataDeclaration v a)
dataDecls')
      effects :: Names
effects = ((v, (Id, EffectDeclaration v a)) -> Names)
-> [(v, (Id, EffectDeclaration v a))] -> Names
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((v -> Name) -> (v, (Id, EffectDeclaration v a)) -> Names
forall v a.
Var v =>
(v -> Name) -> (v, (Id, EffectDeclaration v a)) -> Names
DD.Names.effectDeclToNames' v -> Name
forall v. Var v => v -> Name
Name.unsafeParseVar) (Map v (Id, EffectDeclaration v a)
-> [(v, (Id, EffectDeclaration v a))]
forall k a. Map k a -> [(k, a)]
Map.toList Map v (Id, EffectDeclaration v a)
effectDecls')
      names' :: Names
names' = Names
ctors Names -> Names -> Names
forall a. Semigroup a => a -> a -> a
<> Names
effects
      overlaps :: [Error v a]
overlaps =
        let w :: v -> DataDeclaration v a -> EffectDeclaration v a -> Error v a
w v
v DataDeclaration v a
dd (EffectDeclaration v a -> DataDeclaration v a
forall v a. EffectDeclaration v a -> DataDeclaration v a
toDataDecl -> DataDeclaration v a
ed) = v -> a -> a -> Error v a
forall v a. v -> a -> a -> Error v a
DupDataAndAbility v
v (DataDeclaration v a -> a
forall v a. DataDeclaration v a -> a
DD.annotation DataDeclaration v a
dd) (DataDeclaration v a -> a
forall v a. DataDeclaration v a -> a
DD.annotation DataDeclaration v a
ed)
         in Map v (Error v a) -> [Error v a]
forall k a. Map k a -> [a]
Map.elems (Map v (Error v a) -> [Error v a])
-> Map v (Error v a) -> [Error v a]
forall a b. (a -> b) -> a -> b
$ (v -> DataDeclaration v a -> EffectDeclaration v a -> Error v a)
-> Map v (DataDeclaration v a)
-> Map v (EffectDeclaration v a)
-> Map v (Error v a)
forall k a b c.
Ord k =>
(k -> a -> b -> c) -> Map k a -> Map k b -> Map k c
Map.intersectionWithKey v -> DataDeclaration v a -> EffectDeclaration v a -> Error v a
forall {v} {v} {a} {v}.
v -> DataDeclaration v a -> EffectDeclaration v a -> Error v a
w Map v (DataDeclaration v a)
dataDecls Map v (EffectDeclaration v a)
effectDecls
        where

      okVars :: Set v
okVars = Map v (DataDeclaration v a) -> Set v
forall k a. Map k a -> Set k
Map.keysSet Map v (DataDeclaration v a)
allDecls0
      unknownTypeRefs :: [Error v a]
unknownTypeRefs =
        Map v (DataDeclaration v a) -> [DataDeclaration v a]
forall k a. Map k a -> [a]
Map.elems Map v (DataDeclaration v a)
allDecls0 [DataDeclaration v a]
-> (DataDeclaration v a -> [Error v a]) -> [Error v a]
forall a b. [a] -> (a -> [b]) -> [b]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \DataDeclaration v a
dd ->
          let cts :: [Type v a]
cts = DataDeclaration v a -> [Type v a]
forall v a. DataDeclaration v a -> [Type v a]
DD.constructorTypes DataDeclaration v a
dd
           in [Type v a]
cts [Type v a] -> (Type v a -> [Error v a]) -> [Error v a]
forall a b. [a] -> (a -> [b]) -> [b]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Type v a
ct ->
                [ v -> a -> Error v a
forall v a. v -> a -> Error v a
UnknownType v
v a
a | (v
v, a
a) <- Set v -> Type v a -> [(v, a)]
forall (f :: * -> *) v a.
(Traversable f, Ord v) =>
Set v -> Term f v a -> [(v, a)]
ABT.freeVarOccurrences Set v
forall a. Monoid a => a
mempty Type v a
ct, Bool -> Bool
not (v -> Set v -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member v
v Set v
okVars)
                ]
  Either [Error v a] (Env v a)
-> ResolutionResult a (Either [Error v a] (Env v a))
forall a. a -> Either (Seq (ResolutionFailure a)) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either [Error v a] (Env v a)
 -> ResolutionResult a (Either [Error v a] (Env v a)))
-> Either [Error v a] (Env v a)
-> ResolutionResult a (Either [Error v a] (Env v a))
forall a b. (a -> b) -> a -> b
$
    if [Error v a] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Error v a]
overlaps Bool -> Bool -> Bool
&& [Error v a] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Error v a]
unknownTypeRefs
      then Env v a -> Either [Error v a] (Env v a)
forall a. a -> Either [Error v a] a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Env v a -> Either [Error v a] (Env v a))
-> Env v a -> Either [Error v a] (Env v a)
forall a b. (a -> b) -> a -> b
$ Map v (Id, DataDeclaration v a)
-> Map v (Id, EffectDeclaration v a) -> Names -> Env v a
forall v a.
Map v (Id, DataDeclaration v a)
-> Map v (Id, EffectDeclaration v a) -> Names -> Env v a
Env Map v (Id, DataDeclaration v a)
dataDecls' Map v (Id, EffectDeclaration v a)
effectDecls' Names
names'
      else [Error v a] -> Either [Error v a] (Env v a)
forall a b. a -> Either a b
Left ([Error v a]
unknownTypeRefs [Error v a] -> [Error v a] -> [Error v a]
forall a. [a] -> [a] -> [a]
++ [Error v a]
overlaps)