-- | Resolve names.
--
-- This also performs a small amount of rewriting; specifically
-- turning 'Var's with qualified names into 'Project's, based on
-- whether they are referencing a module or not.
--
-- Also checks for other name-related problems, such as duplicate
-- names.
module Language.Futhark.TypeChecker.Names
  ( resolveValBind,
    resolveTypeParams,
    resolveTypeExp,
    resolveExp,
  )
where

import Control.Monad
import Control.Monad.Except
import Control.Monad.State
import Data.List qualified as L
import Data.Map qualified as M
import Data.Text qualified as T
import Futhark.Util.Pretty
import Language.Futhark
import Language.Futhark.Semantic (includeToFilePath)
import Language.Futhark.TypeChecker.Monad
import Prelude hiding (mod)

-- | Names that may not be shadowed.
doNotShadow :: [Name]
doNotShadow :: [Name]
doNotShadow = [Name
"&&", Name
"||"]

checkDoNotShadow :: (Located a) => a -> Name -> TypeM ()
checkDoNotShadow :: forall a. Located a => a -> Name -> TypeM ()
checkDoNotShadow a
loc Name
v =
  Bool -> TypeM () -> TypeM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Name
v Name -> [Name] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Name]
doNotShadow) (TypeM () -> TypeM ()) -> TypeM () -> TypeM ()
forall a b. (a -> b) -> a -> b
$
    a -> Notes -> Doc () -> TypeM ()
forall loc a. Located loc => loc -> Notes -> Doc () -> TypeM a
forall (m :: * -> *) loc a.
(MonadTypeChecker m, Located loc) =>
loc -> Notes -> Doc () -> m a
typeError a
loc Notes
forall a. Monoid a => a
mempty (Doc () -> TypeM ()) -> (Doc () -> Doc ()) -> Doc () -> TypeM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc () -> Doc () -> Doc ()
forall a. Doc a -> Doc a -> Doc a
withIndexLink Doc ()
"may-not-be-redefined" (Doc () -> TypeM ()) -> Doc () -> TypeM ()
forall a b. (a -> b) -> a -> b
$
      Doc ()
"The" Doc () -> Doc () -> Doc ()
forall a. Doc a -> Doc a -> Doc a
<+> Name -> Doc ()
forall a. Name -> Doc a
forall v a. IsName v => v -> Doc a
prettyName Name
v Doc () -> Doc () -> Doc ()
forall a. Doc a -> Doc a -> Doc a
<+> Doc ()
"operator may not be redefined."

-- | Check whether the type contains arrow types that define the same
-- parameter.  These might also exist further down, but that's not
-- really a problem - we mostly do this checking to help the user,
-- since it is likely an error, but it's easy to assign a semantics to
-- it (normal name shadowing).
checkForDuplicateNamesInType :: TypeExp (ExpBase NoInfo Name) Name -> TypeM ()
checkForDuplicateNamesInType :: TypeExp (ExpBase NoInfo Name) Name -> TypeM ()
checkForDuplicateNamesInType = Map Name SrcLoc -> TypeExp (ExpBase NoInfo Name) Name -> TypeM ()
forall {m :: * -> *} {a} {d}.
(MonadTypeChecker m, Pretty a, Ord a) =>
Map a SrcLoc -> TypeExp d a -> m ()
check Map Name SrcLoc
forall a. Monoid a => a
mempty
  where
    bad :: a -> loc -> a -> m a
bad a
v loc
loc a
prev_loc =
      loc -> Notes -> Doc () -> m a
forall loc a. Located loc => loc -> Notes -> Doc () -> m a
forall (m :: * -> *) loc a.
(MonadTypeChecker m, Located loc) =>
loc -> Notes -> Doc () -> m a
typeError loc
loc Notes
forall a. Monoid a => a
mempty (Doc () -> m a) -> Doc () -> m a
forall a b. (a -> b) -> a -> b
$
        Doc ()
"Name"
          Doc () -> Doc () -> Doc ()
forall a. Doc a -> Doc a -> Doc a
<+> Doc () -> Doc ()
forall ann. Doc ann -> Doc ann
dquotes (a -> Doc ()
forall ann. a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty a
v)
          Doc () -> Doc () -> Doc ()
forall a. Doc a -> Doc a -> Doc a
<+> Doc ()
"also bound at"
          Doc () -> Doc () -> Doc ()
forall a. Doc a -> Doc a -> Doc a
<+> String -> Doc ()
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (a -> String
forall a. Located a => a -> String
locStr a
prev_loc)
          Doc () -> Doc () -> Doc ()
forall a. Semigroup a => a -> a -> a
<> Doc ()
"."

    check :: Map a SrcLoc -> TypeExp d a -> m ()
check Map a SrcLoc
seen (TEArrow (Just a
v) TypeExp d a
t1 TypeExp d a
t2 SrcLoc
loc)
      | Just SrcLoc
prev_loc <- a -> Map a SrcLoc -> Maybe SrcLoc
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup a
v Map a SrcLoc
seen =
          a -> SrcLoc -> SrcLoc -> m ()
forall {m :: * -> *} {a} {loc} {a} {a}.
(MonadTypeChecker m, Pretty a, Located loc, Located a) =>
a -> loc -> a -> m a
bad a
v SrcLoc
loc SrcLoc
prev_loc
      | Bool
otherwise =
          Map a SrcLoc -> TypeExp d a -> m ()
check Map a SrcLoc
seen' TypeExp d a
t1 m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Map a SrcLoc -> TypeExp d a -> m ()
check Map a SrcLoc
seen' TypeExp d a
t2
      where
        seen' :: Map a SrcLoc
seen' = a -> SrcLoc -> Map a SrcLoc -> Map a SrcLoc
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert a
v SrcLoc
loc Map a SrcLoc
seen
    check Map a SrcLoc
seen (TEArrow Maybe a
Nothing TypeExp d a
t1 TypeExp d a
t2 SrcLoc
_) =
      Map a SrcLoc -> TypeExp d a -> m ()
check Map a SrcLoc
seen TypeExp d a
t1 m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Map a SrcLoc -> TypeExp d a -> m ()
check Map a SrcLoc
seen TypeExp d a
t2
    check Map a SrcLoc
seen (TETuple [TypeExp d a]
ts SrcLoc
_) = (TypeExp d a -> m ()) -> [TypeExp d a] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Map a SrcLoc -> TypeExp d a -> m ()
check Map a SrcLoc
seen) [TypeExp d a]
ts
    check Map a SrcLoc
seen (TERecord [(Name, TypeExp d a)]
fs SrcLoc
_) = ((Name, TypeExp d a) -> m ()) -> [(Name, TypeExp d a)] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Map a SrcLoc -> TypeExp d a -> m ()
check Map a SrcLoc
seen (TypeExp d a -> m ())
-> ((Name, TypeExp d a) -> TypeExp d a)
-> (Name, TypeExp d a)
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name, TypeExp d a) -> TypeExp d a
forall a b. (a, b) -> b
snd) [(Name, TypeExp d a)]
fs
    check Map a SrcLoc
seen (TEUnique TypeExp d a
t SrcLoc
_) = Map a SrcLoc -> TypeExp d a -> m ()
check Map a SrcLoc
seen TypeExp d a
t
    check Map a SrcLoc
seen (TESum [(Name, [TypeExp d a])]
cs SrcLoc
_) = ((Name, [TypeExp d a]) -> m [()])
-> [(Name, [TypeExp d a])] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((TypeExp d a -> m ()) -> [TypeExp d a] -> m [()]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Map a SrcLoc -> TypeExp d a -> m ()
check Map a SrcLoc
seen) ([TypeExp d a] -> m [()])
-> ((Name, [TypeExp d a]) -> [TypeExp d a])
-> (Name, [TypeExp d a])
-> m [()]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name, [TypeExp d a]) -> [TypeExp d a]
forall a b. (a, b) -> b
snd) [(Name, [TypeExp d a])]
cs
    check Map a SrcLoc
seen (TEApply TypeExp d a
t1 (TypeArgExpType TypeExp d a
t2) SrcLoc
_) =
      Map a SrcLoc -> TypeExp d a -> m ()
check Map a SrcLoc
seen TypeExp d a
t1 m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Map a SrcLoc -> TypeExp d a -> m ()
check Map a SrcLoc
seen TypeExp d a
t2
    check Map a SrcLoc
seen (TEApply TypeExp d a
t1 TypeArgExpSize {} SrcLoc
_) =
      Map a SrcLoc -> TypeExp d a -> m ()
check Map a SrcLoc
seen TypeExp d a
t1
    check Map a SrcLoc
seen (TEDim (a
v : [a]
vs) TypeExp d a
t SrcLoc
loc)
      | Just SrcLoc
prev_loc <- a -> Map a SrcLoc -> Maybe SrcLoc
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup a
v Map a SrcLoc
seen =
          a -> SrcLoc -> SrcLoc -> m ()
forall {m :: * -> *} {a} {loc} {a} {a}.
(MonadTypeChecker m, Pretty a, Located loc, Located a) =>
a -> loc -> a -> m a
bad a
v SrcLoc
loc SrcLoc
prev_loc
      | Bool
otherwise =
          Map a SrcLoc -> TypeExp d a -> m ()
check (a -> SrcLoc -> Map a SrcLoc -> Map a SrcLoc
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert a
v SrcLoc
loc Map a SrcLoc
seen) ([a] -> TypeExp d a -> SrcLoc -> TypeExp d a
forall d vn. [vn] -> TypeExp d vn -> SrcLoc -> TypeExp d vn
TEDim [a]
vs TypeExp d a
t SrcLoc
loc)
    check Map a SrcLoc
seen (TEDim [] TypeExp d a
t SrcLoc
_) =
      Map a SrcLoc -> TypeExp d a -> m ()
check Map a SrcLoc
seen TypeExp d a
t
    check Map a SrcLoc
_ TEArray {} = () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    check Map a SrcLoc
_ TEVar {} = () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    check Map a SrcLoc
seen (TEParens TypeExp d a
te SrcLoc
_) = Map a SrcLoc -> TypeExp d a -> m ()
check Map a SrcLoc
seen TypeExp d a
te

-- | Check for duplication of names inside a binding group.
checkForDuplicateNames ::
  (MonadTypeChecker m) => [UncheckedTypeParam] -> [UncheckedPat t] -> m ()
checkForDuplicateNames :: forall (m :: * -> *) t.
MonadTypeChecker m =>
[UncheckedTypeParam] -> [UncheckedPat t] -> m ()
checkForDuplicateNames [UncheckedTypeParam]
tps [UncheckedPat t]
pats = (StateT (Map (Namespace, Name) SrcLoc) m ()
-> Map (Namespace, Name) SrcLoc -> m ()
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
`evalStateT` Map (Namespace, Name) SrcLoc
forall a. Monoid a => a
mempty) (StateT (Map (Namespace, Name) SrcLoc) m () -> m ())
-> StateT (Map (Namespace, Name) SrcLoc) m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
  (UncheckedTypeParam -> StateT (Map (Namespace, Name) SrcLoc) m ())
-> [UncheckedTypeParam]
-> StateT (Map (Namespace, Name) SrcLoc) m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ UncheckedTypeParam -> StateT (Map (Namespace, Name) SrcLoc) m ()
forall {b} {m :: * -> *} {t :: (* -> *) -> * -> *}.
(Pretty b, MonadTypeChecker m, MonadTrans t, Ord b,
 MonadState (Map (Namespace, b) SrcLoc) (t m)) =>
TypeParamBase b -> t m ()
checkTypeParam [UncheckedTypeParam]
tps
  (UncheckedPat t -> StateT (Map (Namespace, Name) SrcLoc) m ())
-> [UncheckedPat t] -> StateT (Map (Namespace, Name) SrcLoc) m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ UncheckedPat t -> StateT (Map (Namespace, Name) SrcLoc) m ()
forall {b} {m :: * -> *} {t :: (* -> *) -> * -> *} {f :: * -> *}
       {t}.
(Pretty b, MonadTypeChecker m, MonadTrans t, Ord b,
 MonadState (Map (Namespace, b) SrcLoc) (t m)) =>
PatBase f b t -> t m ()
checkPat [UncheckedPat t]
pats
  where
    checkTypeParam :: TypeParamBase b -> t m ()
checkTypeParam (TypeParamType Liftedness
_ b
v SrcLoc
loc) = Namespace -> b -> SrcLoc -> t m ()
forall {a} {b} {m :: * -> *} {t :: (* -> *) -> * -> *} {a}.
(Located a, Pretty b, MonadTypeChecker m, MonadTrans t, Ord b,
 Ord a, MonadState (Map (a, b) a) (t m)) =>
a -> b -> a -> t m ()
seen Namespace
Type b
v SrcLoc
loc
    checkTypeParam (TypeParamDim b
v SrcLoc
loc) = Namespace -> b -> SrcLoc -> t m ()
forall {a} {b} {m :: * -> *} {t :: (* -> *) -> * -> *} {a}.
(Located a, Pretty b, MonadTypeChecker m, MonadTrans t, Ord b,
 Ord a, MonadState (Map (a, b) a) (t m)) =>
a -> b -> a -> t m ()
seen Namespace
Term b
v SrcLoc
loc

    checkPat :: PatBase f b t -> t m ()
checkPat (Id b
v f t
_ SrcLoc
loc) = Namespace -> b -> SrcLoc -> t m ()
forall {a} {b} {m :: * -> *} {t :: (* -> *) -> * -> *} {a}.
(Located a, Pretty b, MonadTypeChecker m, MonadTrans t, Ord b,
 Ord a, MonadState (Map (a, b) a) (t m)) =>
a -> b -> a -> t m ()
seen Namespace
Term b
v SrcLoc
loc
    checkPat (PatParens PatBase f b t
p SrcLoc
_) = PatBase f b t -> t m ()
checkPat PatBase f b t
p
    checkPat (PatAttr AttrInfo b
_ PatBase f b t
p SrcLoc
_) = PatBase f b t -> t m ()
checkPat PatBase f b t
p
    checkPat Wildcard {} = () -> t m ()
forall a. a -> t m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    checkPat (TuplePat [PatBase f b t]
ps SrcLoc
_) = (PatBase f b t -> t m ()) -> [PatBase f b t] -> t m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ PatBase f b t -> t m ()
checkPat [PatBase f b t]
ps
    checkPat (RecordPat [(Name, PatBase f b t)]
fs SrcLoc
_) = ((Name, PatBase f b t) -> t m ())
-> [(Name, PatBase f b t)] -> t m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (PatBase f b t -> t m ()
checkPat (PatBase f b t -> t m ())
-> ((Name, PatBase f b t) -> PatBase f b t)
-> (Name, PatBase f b t)
-> t m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name, PatBase f b t) -> PatBase f b t
forall a b. (a, b) -> b
snd) [(Name, PatBase f b t)]
fs
    checkPat (PatAscription PatBase f b t
p TypeExp (ExpBase f b) b
_ SrcLoc
_) = PatBase f b t -> t m ()
checkPat PatBase f b t
p
    checkPat PatLit {} = () -> t m ()
forall a. a -> t m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    checkPat (PatConstr Name
_ f t
_ [PatBase f b t]
ps SrcLoc
_) = (PatBase f b t -> t m ()) -> [PatBase f b t] -> t m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ PatBase f b t -> t m ()
checkPat [PatBase f b t]
ps

    seen :: a -> b -> a -> t m ()
seen a
ns b
v a
loc = do
      Maybe a
already <- (Map (a, b) a -> Maybe a) -> t m (Maybe a)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ((Map (a, b) a -> Maybe a) -> t m (Maybe a))
-> (Map (a, b) a -> Maybe a) -> t m (Maybe a)
forall a b. (a -> b) -> a -> b
$ (a, b) -> Map (a, b) a -> Maybe a
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (a
ns, b
v)
      case Maybe a
already of
        Just a
prev_loc ->
          m () -> t m ()
forall (m :: * -> *) a. Monad m => m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> t m ()) -> m () -> t m ()
forall a b. (a -> b) -> a -> b
$
            a -> Notes -> Doc () -> m ()
forall loc a. Located loc => loc -> Notes -> Doc () -> m a
forall (m :: * -> *) loc a.
(MonadTypeChecker m, Located loc) =>
loc -> Notes -> Doc () -> m a
typeError a
loc Notes
forall a. Monoid a => a
mempty (Doc () -> m ()) -> Doc () -> m ()
forall a b. (a -> b) -> a -> b
$
              Doc ()
"Name"
                Doc () -> Doc () -> Doc ()
forall a. Doc a -> Doc a -> Doc a
<+> Doc () -> Doc ()
forall ann. Doc ann -> Doc ann
dquotes (b -> Doc ()
forall ann. b -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty b
v)
                Doc () -> Doc () -> Doc ()
forall a. Doc a -> Doc a -> Doc a
<+> Doc ()
"also bound at"
                Doc () -> Doc () -> Doc ()
forall a. Doc a -> Doc a -> Doc a
<+> String -> Doc ()
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (a -> String
forall a. Located a => a -> String
locStr a
prev_loc)
                Doc () -> Doc () -> Doc ()
forall a. Semigroup a => a -> a -> a
<> Doc ()
"."
        Maybe a
Nothing ->
          (Map (a, b) a -> Map (a, b) a) -> t m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((Map (a, b) a -> Map (a, b) a) -> t m ())
-> (Map (a, b) a -> Map (a, b) a) -> t m ()
forall a b. (a -> b) -> a -> b
$ (a, b) -> a -> Map (a, b) a -> Map (a, b) a
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert (a
ns, b
v) a
loc

resolveQualName :: QualName Name -> SrcLoc -> TypeM (QualName VName)
resolveQualName :: QualName Name -> SrcLoc -> TypeM (QualName VName)
resolveQualName QualName Name
v SrcLoc
loc = do
  QualName VName
v' <- QualName Name -> SrcLoc -> TypeM (QualName VName)
checkValName QualName Name
v SrcLoc
loc
  case QualName VName
v' of
    QualName (VName
q : [VName]
_) VName
_
      | VName -> Int
baseTag VName
q Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
maxIntrinsicTag -> do
          ImportName
me <- TypeM ImportName
askImportName
          Bool -> TypeM () -> TypeM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (String -> Bool
isBuiltin (ImportName -> String
includeToFilePath ImportName
me)) (TypeM () -> TypeM ()) -> TypeM () -> TypeM ()
forall a b. (a -> b) -> a -> b
$
            SrcLoc -> Doc () -> TypeM ()
forall loc. Located loc => loc -> Doc () -> TypeM ()
forall (m :: * -> *) loc.
(MonadTypeChecker m, Located loc) =>
loc -> Doc () -> m ()
warn SrcLoc
loc Doc ()
"Using intrinsic functions directly can easily crash the compiler or result in wrong code generation."
    QualName VName
_ -> () -> TypeM ()
forall a. a -> TypeM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  QualName VName -> TypeM (QualName VName)
forall a. a -> TypeM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure QualName VName
v'

resolveName :: Name -> SrcLoc -> TypeM VName
resolveName :: Name -> SrcLoc -> TypeM VName
resolveName Name
v SrcLoc
loc = QualName VName -> VName
forall vn. QualName vn -> vn
qualLeaf (QualName VName -> VName) -> TypeM (QualName VName) -> TypeM VName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> QualName Name -> SrcLoc -> TypeM (QualName VName)
resolveQualName (Name -> QualName Name
forall v. v -> QualName v
qualName Name
v) SrcLoc
loc

resolveAttrAtom :: AttrAtom Name -> TypeM (AttrAtom VName)
resolveAttrAtom :: AttrAtom Name -> TypeM (AttrAtom VName)
resolveAttrAtom (AtomName Name
v) = AttrAtom VName -> TypeM (AttrAtom VName)
forall a. a -> TypeM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AttrAtom VName -> TypeM (AttrAtom VName))
-> AttrAtom VName -> TypeM (AttrAtom VName)
forall a b. (a -> b) -> a -> b
$ Name -> AttrAtom VName
forall {k} (vn :: k). Name -> AttrAtom vn
AtomName Name
v
resolveAttrAtom (AtomInt Integer
x) = AttrAtom VName -> TypeM (AttrAtom VName)
forall a. a -> TypeM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AttrAtom VName -> TypeM (AttrAtom VName))
-> AttrAtom VName -> TypeM (AttrAtom VName)
forall a b. (a -> b) -> a -> b
$ Integer -> AttrAtom VName
forall {k} (vn :: k). Integer -> AttrAtom vn
AtomInt Integer
x

resolveAttrInfo :: AttrInfo Name -> TypeM (AttrInfo VName)
resolveAttrInfo :: AttrInfo Name -> TypeM (AttrInfo VName)
resolveAttrInfo (AttrAtom AttrAtom Name
atom SrcLoc
loc) =
  AttrAtom VName -> SrcLoc -> AttrInfo VName
forall {k} (vn :: k). AttrAtom vn -> SrcLoc -> AttrInfo vn
AttrAtom (AttrAtom VName -> SrcLoc -> AttrInfo VName)
-> TypeM (AttrAtom VName) -> TypeM (SrcLoc -> AttrInfo VName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AttrAtom Name -> TypeM (AttrAtom VName)
resolveAttrAtom AttrAtom Name
atom TypeM (SrcLoc -> AttrInfo VName)
-> TypeM SrcLoc -> TypeM (AttrInfo VName)
forall a b. TypeM (a -> b) -> TypeM a -> TypeM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SrcLoc -> TypeM SrcLoc
forall a. a -> TypeM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
loc
resolveAttrInfo (AttrComp Name
name [AttrInfo Name]
infos SrcLoc
loc) =
  Name -> [AttrInfo VName] -> SrcLoc -> AttrInfo VName
forall {k} (vn :: k).
Name -> [AttrInfo vn] -> SrcLoc -> AttrInfo vn
AttrComp Name
name ([AttrInfo VName] -> SrcLoc -> AttrInfo VName)
-> TypeM [AttrInfo VName] -> TypeM (SrcLoc -> AttrInfo VName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (AttrInfo Name -> TypeM (AttrInfo VName))
-> [AttrInfo Name] -> TypeM [AttrInfo VName]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM AttrInfo Name -> TypeM (AttrInfo VName)
resolveAttrInfo [AttrInfo Name]
infos TypeM (SrcLoc -> AttrInfo VName)
-> TypeM SrcLoc -> TypeM (AttrInfo VName)
forall a b. TypeM (a -> b) -> TypeM a -> TypeM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SrcLoc -> TypeM SrcLoc
forall a. a -> TypeM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
loc

resolveSizeExp :: SizeExp (ExpBase NoInfo Name) -> TypeM (SizeExp (ExpBase NoInfo VName))
resolveSizeExp :: SizeExp (ExpBase NoInfo Name)
-> TypeM (SizeExp (ExpBase NoInfo VName))
resolveSizeExp (SizeExpAny SrcLoc
loc) = SizeExp (ExpBase NoInfo VName)
-> TypeM (SizeExp (ExpBase NoInfo VName))
forall a. a -> TypeM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SizeExp (ExpBase NoInfo VName)
 -> TypeM (SizeExp (ExpBase NoInfo VName)))
-> SizeExp (ExpBase NoInfo VName)
-> TypeM (SizeExp (ExpBase NoInfo VName))
forall a b. (a -> b) -> a -> b
$ SrcLoc -> SizeExp (ExpBase NoInfo VName)
forall d. SrcLoc -> SizeExp d
SizeExpAny SrcLoc
loc
resolveSizeExp (SizeExp ExpBase NoInfo Name
e SrcLoc
loc) = ExpBase NoInfo VName -> SrcLoc -> SizeExp (ExpBase NoInfo VName)
forall d. d -> SrcLoc -> SizeExp d
SizeExp (ExpBase NoInfo VName -> SrcLoc -> SizeExp (ExpBase NoInfo VName))
-> TypeM (ExpBase NoInfo VName)
-> TypeM (SrcLoc -> SizeExp (ExpBase NoInfo VName))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ExpBase NoInfo Name -> TypeM (ExpBase NoInfo VName)
resolveExp ExpBase NoInfo Name
e TypeM (SrcLoc -> SizeExp (ExpBase NoInfo VName))
-> TypeM SrcLoc -> TypeM (SizeExp (ExpBase NoInfo VName))
forall a b. TypeM (a -> b) -> TypeM a -> TypeM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SrcLoc -> TypeM SrcLoc
forall a. a -> TypeM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
loc

-- | Resolve names in a single type expression.
resolveTypeExp ::
  TypeExp (ExpBase NoInfo Name) Name ->
  TypeM (TypeExp (ExpBase NoInfo VName) VName)
resolveTypeExp :: TypeExp (ExpBase NoInfo Name) Name
-> TypeM (TypeExp (ExpBase NoInfo VName) VName)
resolveTypeExp TypeExp (ExpBase NoInfo Name) Name
orig = TypeExp (ExpBase NoInfo Name) Name -> TypeM ()
checkForDuplicateNamesInType TypeExp (ExpBase NoInfo Name) Name
orig TypeM ()
-> TypeM (TypeExp (ExpBase NoInfo VName) VName)
-> TypeM (TypeExp (ExpBase NoInfo VName) VName)
forall a b. TypeM a -> TypeM b -> TypeM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TypeExp (ExpBase NoInfo Name) Name
-> TypeM (TypeExp (ExpBase NoInfo VName) VName)
f TypeExp (ExpBase NoInfo Name) Name
orig
  where
    f :: TypeExp (ExpBase NoInfo Name) Name
-> TypeM (TypeExp (ExpBase NoInfo VName) VName)
f (TEVar QualName Name
v SrcLoc
loc) =
      QualName VName -> SrcLoc -> TypeExp (ExpBase NoInfo VName) VName
forall d vn. QualName vn -> SrcLoc -> TypeExp d vn
TEVar (QualName VName -> SrcLoc -> TypeExp (ExpBase NoInfo VName) VName)
-> TypeM (QualName VName)
-> TypeM (SrcLoc -> TypeExp (ExpBase NoInfo VName) VName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Namespace -> QualName Name -> SrcLoc -> TypeM (QualName VName)
checkQualName Namespace
Type QualName Name
v SrcLoc
loc TypeM (SrcLoc -> TypeExp (ExpBase NoInfo VName) VName)
-> TypeM SrcLoc -> TypeM (TypeExp (ExpBase NoInfo VName) VName)
forall a b. TypeM (a -> b) -> TypeM a -> TypeM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SrcLoc -> TypeM SrcLoc
forall a. a -> TypeM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
loc
    f (TEParens TypeExp (ExpBase NoInfo Name) Name
te SrcLoc
loc) =
      TypeExp (ExpBase NoInfo VName) VName
-> SrcLoc -> TypeExp (ExpBase NoInfo VName) VName
forall d vn. TypeExp d vn -> SrcLoc -> TypeExp d vn
TEParens (TypeExp (ExpBase NoInfo VName) VName
 -> SrcLoc -> TypeExp (ExpBase NoInfo VName) VName)
-> TypeM (TypeExp (ExpBase NoInfo VName) VName)
-> TypeM (SrcLoc -> TypeExp (ExpBase NoInfo VName) VName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TypeExp (ExpBase NoInfo Name) Name
-> TypeM (TypeExp (ExpBase NoInfo VName) VName)
f TypeExp (ExpBase NoInfo Name) Name
te TypeM (SrcLoc -> TypeExp (ExpBase NoInfo VName) VName)
-> TypeM SrcLoc -> TypeM (TypeExp (ExpBase NoInfo VName) VName)
forall a b. TypeM (a -> b) -> TypeM a -> TypeM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SrcLoc -> TypeM SrcLoc
forall a. a -> TypeM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
loc
    f (TETuple [TypeExp (ExpBase NoInfo Name) Name]
tes SrcLoc
loc) =
      [TypeExp (ExpBase NoInfo VName) VName]
-> SrcLoc -> TypeExp (ExpBase NoInfo VName) VName
forall d vn. [TypeExp d vn] -> SrcLoc -> TypeExp d vn
TETuple ([TypeExp (ExpBase NoInfo VName) VName]
 -> SrcLoc -> TypeExp (ExpBase NoInfo VName) VName)
-> TypeM [TypeExp (ExpBase NoInfo VName) VName]
-> TypeM (SrcLoc -> TypeExp (ExpBase NoInfo VName) VName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (TypeExp (ExpBase NoInfo Name) Name
 -> TypeM (TypeExp (ExpBase NoInfo VName) VName))
-> [TypeExp (ExpBase NoInfo Name) Name]
-> TypeM [TypeExp (ExpBase NoInfo VName) VName]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM TypeExp (ExpBase NoInfo Name) Name
-> TypeM (TypeExp (ExpBase NoInfo VName) VName)
f [TypeExp (ExpBase NoInfo Name) Name]
tes TypeM (SrcLoc -> TypeExp (ExpBase NoInfo VName) VName)
-> TypeM SrcLoc -> TypeM (TypeExp (ExpBase NoInfo VName) VName)
forall a b. TypeM (a -> b) -> TypeM a -> TypeM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SrcLoc -> TypeM SrcLoc
forall a. a -> TypeM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
loc
    f (TERecord [(Name, TypeExp (ExpBase NoInfo Name) Name)]
fs SrcLoc
loc) =
      [(Name, TypeExp (ExpBase NoInfo VName) VName)]
-> SrcLoc -> TypeExp (ExpBase NoInfo VName) VName
forall d vn. [(Name, TypeExp d vn)] -> SrcLoc -> TypeExp d vn
TERecord ([(Name, TypeExp (ExpBase NoInfo VName) VName)]
 -> SrcLoc -> TypeExp (ExpBase NoInfo VName) VName)
-> TypeM [(Name, TypeExp (ExpBase NoInfo VName) VName)]
-> TypeM (SrcLoc -> TypeExp (ExpBase NoInfo VName) VName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Name, TypeExp (ExpBase NoInfo Name) Name)
 -> TypeM (Name, TypeExp (ExpBase NoInfo VName) VName))
-> [(Name, TypeExp (ExpBase NoInfo Name) Name)]
-> TypeM [(Name, TypeExp (ExpBase NoInfo VName) VName)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((TypeExp (ExpBase NoInfo Name) Name
 -> TypeM (TypeExp (ExpBase NoInfo VName) VName))
-> (Name, TypeExp (ExpBase NoInfo Name) Name)
-> TypeM (Name, TypeExp (ExpBase NoInfo VName) VName)
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) -> (Name, a) -> f (Name, b)
traverse TypeExp (ExpBase NoInfo Name) Name
-> TypeM (TypeExp (ExpBase NoInfo VName) VName)
f) [(Name, TypeExp (ExpBase NoInfo Name) Name)]
fs TypeM (SrcLoc -> TypeExp (ExpBase NoInfo VName) VName)
-> TypeM SrcLoc -> TypeM (TypeExp (ExpBase NoInfo VName) VName)
forall a b. TypeM (a -> b) -> TypeM a -> TypeM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SrcLoc -> TypeM SrcLoc
forall a. a -> TypeM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
loc
    f (TEUnique TypeExp (ExpBase NoInfo Name) Name
te SrcLoc
loc) =
      TypeExp (ExpBase NoInfo VName) VName
-> SrcLoc -> TypeExp (ExpBase NoInfo VName) VName
forall d vn. TypeExp d vn -> SrcLoc -> TypeExp d vn
TEUnique (TypeExp (ExpBase NoInfo VName) VName
 -> SrcLoc -> TypeExp (ExpBase NoInfo VName) VName)
-> TypeM (TypeExp (ExpBase NoInfo VName) VName)
-> TypeM (SrcLoc -> TypeExp (ExpBase NoInfo VName) VName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TypeExp (ExpBase NoInfo Name) Name
-> TypeM (TypeExp (ExpBase NoInfo VName) VName)
f TypeExp (ExpBase NoInfo Name) Name
te TypeM (SrcLoc -> TypeExp (ExpBase NoInfo VName) VName)
-> TypeM SrcLoc -> TypeM (TypeExp (ExpBase NoInfo VName) VName)
forall a b. TypeM (a -> b) -> TypeM a -> TypeM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SrcLoc -> TypeM SrcLoc
forall a. a -> TypeM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
loc
    f (TEApply TypeExp (ExpBase NoInfo Name) Name
te1 TypeArgExp (ExpBase NoInfo Name) Name
args SrcLoc
loc) =
      TypeExp (ExpBase NoInfo VName) VName
-> TypeArgExp (ExpBase NoInfo VName) VName
-> SrcLoc
-> TypeExp (ExpBase NoInfo VName) VName
forall d vn.
TypeExp d vn -> TypeArgExp d vn -> SrcLoc -> TypeExp d vn
TEApply (TypeExp (ExpBase NoInfo VName) VName
 -> TypeArgExp (ExpBase NoInfo VName) VName
 -> SrcLoc
 -> TypeExp (ExpBase NoInfo VName) VName)
-> TypeM (TypeExp (ExpBase NoInfo VName) VName)
-> TypeM
     (TypeArgExp (ExpBase NoInfo VName) VName
      -> SrcLoc -> TypeExp (ExpBase NoInfo VName) VName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TypeExp (ExpBase NoInfo Name) Name
-> TypeM (TypeExp (ExpBase NoInfo VName) VName)
f TypeExp (ExpBase NoInfo Name) Name
te1 TypeM
  (TypeArgExp (ExpBase NoInfo VName) VName
   -> SrcLoc -> TypeExp (ExpBase NoInfo VName) VName)
-> TypeM (TypeArgExp (ExpBase NoInfo VName) VName)
-> TypeM (SrcLoc -> TypeExp (ExpBase NoInfo VName) VName)
forall a b. TypeM (a -> b) -> TypeM a -> TypeM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TypeArgExp (ExpBase NoInfo Name) Name
-> TypeM (TypeArgExp (ExpBase NoInfo VName) VName)
onArg TypeArgExp (ExpBase NoInfo Name) Name
args TypeM (SrcLoc -> TypeExp (ExpBase NoInfo VName) VName)
-> TypeM SrcLoc -> TypeM (TypeExp (ExpBase NoInfo VName) VName)
forall a b. TypeM (a -> b) -> TypeM a -> TypeM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SrcLoc -> TypeM SrcLoc
forall a. a -> TypeM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
loc
      where
        onArg :: TypeArgExp (ExpBase NoInfo Name) Name
-> TypeM (TypeArgExp (ExpBase NoInfo VName) VName)
onArg (TypeArgExpSize SizeExp (ExpBase NoInfo Name)
size) = SizeExp (ExpBase NoInfo VName)
-> TypeArgExp (ExpBase NoInfo VName) VName
forall d vn. SizeExp d -> TypeArgExp d vn
TypeArgExpSize (SizeExp (ExpBase NoInfo VName)
 -> TypeArgExp (ExpBase NoInfo VName) VName)
-> TypeM (SizeExp (ExpBase NoInfo VName))
-> TypeM (TypeArgExp (ExpBase NoInfo VName) VName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SizeExp (ExpBase NoInfo Name)
-> TypeM (SizeExp (ExpBase NoInfo VName))
resolveSizeExp SizeExp (ExpBase NoInfo Name)
size
        onArg (TypeArgExpType TypeExp (ExpBase NoInfo Name) Name
te) = TypeExp (ExpBase NoInfo VName) VName
-> TypeArgExp (ExpBase NoInfo VName) VName
forall d vn. TypeExp d vn -> TypeArgExp d vn
TypeArgExpType (TypeExp (ExpBase NoInfo VName) VName
 -> TypeArgExp (ExpBase NoInfo VName) VName)
-> TypeM (TypeExp (ExpBase NoInfo VName) VName)
-> TypeM (TypeArgExp (ExpBase NoInfo VName) VName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TypeExp (ExpBase NoInfo Name) Name
-> TypeM (TypeExp (ExpBase NoInfo VName) VName)
f TypeExp (ExpBase NoInfo Name) Name
te
    f (TEArrow Maybe Name
Nothing TypeExp (ExpBase NoInfo Name) Name
te1 TypeExp (ExpBase NoInfo Name) Name
te2 SrcLoc
loc) =
      Maybe VName
-> TypeExp (ExpBase NoInfo VName) VName
-> TypeExp (ExpBase NoInfo VName) VName
-> SrcLoc
-> TypeExp (ExpBase NoInfo VName) VName
forall d vn.
Maybe vn -> TypeExp d vn -> TypeExp d vn -> SrcLoc -> TypeExp d vn
TEArrow Maybe VName
forall a. Maybe a
Nothing (TypeExp (ExpBase NoInfo VName) VName
 -> TypeExp (ExpBase NoInfo VName) VName
 -> SrcLoc
 -> TypeExp (ExpBase NoInfo VName) VName)
-> TypeM (TypeExp (ExpBase NoInfo VName) VName)
-> TypeM
     (TypeExp (ExpBase NoInfo VName) VName
      -> SrcLoc -> TypeExp (ExpBase NoInfo VName) VName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TypeExp (ExpBase NoInfo Name) Name
-> TypeM (TypeExp (ExpBase NoInfo VName) VName)
f TypeExp (ExpBase NoInfo Name) Name
te1 TypeM
  (TypeExp (ExpBase NoInfo VName) VName
   -> SrcLoc -> TypeExp (ExpBase NoInfo VName) VName)
-> TypeM (TypeExp (ExpBase NoInfo VName) VName)
-> TypeM (SrcLoc -> TypeExp (ExpBase NoInfo VName) VName)
forall a b. TypeM (a -> b) -> TypeM a -> TypeM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TypeExp (ExpBase NoInfo Name) Name
-> TypeM (TypeExp (ExpBase NoInfo VName) VName)
f TypeExp (ExpBase NoInfo Name) Name
te2 TypeM (SrcLoc -> TypeExp (ExpBase NoInfo VName) VName)
-> TypeM SrcLoc -> TypeM (TypeExp (ExpBase NoInfo VName) VName)
forall a b. TypeM (a -> b) -> TypeM a -> TypeM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SrcLoc -> TypeM SrcLoc
forall a. a -> TypeM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
loc
    f (TEArrow (Just Name
v) TypeExp (ExpBase NoInfo Name) Name
te1 TypeExp (ExpBase NoInfo Name) Name
te2 SrcLoc
loc) =
      Namespace
-> Name
-> SrcLoc
-> (VName -> TypeM (TypeExp (ExpBase NoInfo VName) VName))
-> TypeM (TypeExp (ExpBase NoInfo VName) VName)
forall a.
Namespace -> Name -> SrcLoc -> (VName -> TypeM a) -> TypeM a
bindSpaced1 Namespace
Term Name
v SrcLoc
loc ((VName -> TypeM (TypeExp (ExpBase NoInfo VName) VName))
 -> TypeM (TypeExp (ExpBase NoInfo VName) VName))
-> (VName -> TypeM (TypeExp (ExpBase NoInfo VName) VName))
-> TypeM (TypeExp (ExpBase NoInfo VName) VName)
forall a b. (a -> b) -> a -> b
$ \VName
v' -> do
        VName -> TypeM ()
usedName VName
v'
        Maybe VName
-> TypeExp (ExpBase NoInfo VName) VName
-> TypeExp (ExpBase NoInfo VName) VName
-> SrcLoc
-> TypeExp (ExpBase NoInfo VName) VName
forall d vn.
Maybe vn -> TypeExp d vn -> TypeExp d vn -> SrcLoc -> TypeExp d vn
TEArrow (VName -> Maybe VName
forall a. a -> Maybe a
Just VName
v') (TypeExp (ExpBase NoInfo VName) VName
 -> TypeExp (ExpBase NoInfo VName) VName
 -> SrcLoc
 -> TypeExp (ExpBase NoInfo VName) VName)
-> TypeM (TypeExp (ExpBase NoInfo VName) VName)
-> TypeM
     (TypeExp (ExpBase NoInfo VName) VName
      -> SrcLoc -> TypeExp (ExpBase NoInfo VName) VName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TypeExp (ExpBase NoInfo Name) Name
-> TypeM (TypeExp (ExpBase NoInfo VName) VName)
f TypeExp (ExpBase NoInfo Name) Name
te1 TypeM
  (TypeExp (ExpBase NoInfo VName) VName
   -> SrcLoc -> TypeExp (ExpBase NoInfo VName) VName)
-> TypeM (TypeExp (ExpBase NoInfo VName) VName)
-> TypeM (SrcLoc -> TypeExp (ExpBase NoInfo VName) VName)
forall a b. TypeM (a -> b) -> TypeM a -> TypeM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TypeExp (ExpBase NoInfo Name) Name
-> TypeM (TypeExp (ExpBase NoInfo VName) VName)
f TypeExp (ExpBase NoInfo Name) Name
te2 TypeM (SrcLoc -> TypeExp (ExpBase NoInfo VName) VName)
-> TypeM SrcLoc -> TypeM (TypeExp (ExpBase NoInfo VName) VName)
forall a b. TypeM (a -> b) -> TypeM a -> TypeM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SrcLoc -> TypeM SrcLoc
forall a. a -> TypeM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
loc
    f (TESum [(Name, [TypeExp (ExpBase NoInfo Name) Name])]
cs SrcLoc
loc) =
      [(Name, [TypeExp (ExpBase NoInfo VName) VName])]
-> SrcLoc -> TypeExp (ExpBase NoInfo VName) VName
forall d vn. [(Name, [TypeExp d vn])] -> SrcLoc -> TypeExp d vn
TESum ([(Name, [TypeExp (ExpBase NoInfo VName) VName])]
 -> SrcLoc -> TypeExp (ExpBase NoInfo VName) VName)
-> TypeM [(Name, [TypeExp (ExpBase NoInfo VName) VName])]
-> TypeM (SrcLoc -> TypeExp (ExpBase NoInfo VName) VName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Name, [TypeExp (ExpBase NoInfo Name) Name])
 -> TypeM (Name, [TypeExp (ExpBase NoInfo VName) VName]))
-> [(Name, [TypeExp (ExpBase NoInfo Name) Name])]
-> TypeM [(Name, [TypeExp (ExpBase NoInfo VName) VName])]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (([TypeExp (ExpBase NoInfo Name) Name]
 -> TypeM [TypeExp (ExpBase NoInfo VName) VName])
-> (Name, [TypeExp (ExpBase NoInfo Name) Name])
-> TypeM (Name, [TypeExp (ExpBase NoInfo VName) VName])
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) -> (Name, a) -> f (Name, b)
traverse (([TypeExp (ExpBase NoInfo Name) Name]
  -> TypeM [TypeExp (ExpBase NoInfo VName) VName])
 -> (Name, [TypeExp (ExpBase NoInfo Name) Name])
 -> TypeM (Name, [TypeExp (ExpBase NoInfo VName) VName]))
-> ([TypeExp (ExpBase NoInfo Name) Name]
    -> TypeM [TypeExp (ExpBase NoInfo VName) VName])
-> (Name, [TypeExp (ExpBase NoInfo Name) Name])
-> TypeM (Name, [TypeExp (ExpBase NoInfo VName) VName])
forall a b. (a -> b) -> a -> b
$ (TypeExp (ExpBase NoInfo Name) Name
 -> TypeM (TypeExp (ExpBase NoInfo VName) VName))
-> [TypeExp (ExpBase NoInfo Name) Name]
-> TypeM [TypeExp (ExpBase NoInfo VName) VName]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM TypeExp (ExpBase NoInfo Name) Name
-> TypeM (TypeExp (ExpBase NoInfo VName) VName)
f) [(Name, [TypeExp (ExpBase NoInfo Name) Name])]
cs TypeM (SrcLoc -> TypeExp (ExpBase NoInfo VName) VName)
-> TypeM SrcLoc -> TypeM (TypeExp (ExpBase NoInfo VName) VName)
forall a b. TypeM (a -> b) -> TypeM a -> TypeM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SrcLoc -> TypeM SrcLoc
forall a. a -> TypeM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
loc
    f (TEDim [Name]
vs TypeExp (ExpBase NoInfo Name) Name
te SrcLoc
loc) =
      [(Namespace, Name, SrcLoc)]
-> ([VName] -> TypeM (TypeExp (ExpBase NoInfo VName) VName))
-> TypeM (TypeExp (ExpBase NoInfo VName) VName)
forall a.
[(Namespace, Name, SrcLoc)] -> ([VName] -> TypeM a) -> TypeM a
bindSpaced ((Name -> (Namespace, Name, SrcLoc))
-> [Name] -> [(Namespace, Name, SrcLoc)]
forall a b. (a -> b) -> [a] -> [b]
map (Namespace
Term,,SrcLoc
loc) [Name]
vs) (([VName] -> TypeM (TypeExp (ExpBase NoInfo VName) VName))
 -> TypeM (TypeExp (ExpBase NoInfo VName) VName))
-> ([VName] -> TypeM (TypeExp (ExpBase NoInfo VName) VName))
-> TypeM (TypeExp (ExpBase NoInfo VName) VName)
forall a b. (a -> b) -> a -> b
$ \[VName]
vs' ->
        [VName]
-> TypeExp (ExpBase NoInfo VName) VName
-> SrcLoc
-> TypeExp (ExpBase NoInfo VName) VName
forall d vn. [vn] -> TypeExp d vn -> SrcLoc -> TypeExp d vn
TEDim [VName]
vs' (TypeExp (ExpBase NoInfo VName) VName
 -> SrcLoc -> TypeExp (ExpBase NoInfo VName) VName)
-> TypeM (TypeExp (ExpBase NoInfo VName) VName)
-> TypeM (SrcLoc -> TypeExp (ExpBase NoInfo VName) VName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TypeExp (ExpBase NoInfo Name) Name
-> TypeM (TypeExp (ExpBase NoInfo VName) VName)
f TypeExp (ExpBase NoInfo Name) Name
te TypeM (SrcLoc -> TypeExp (ExpBase NoInfo VName) VName)
-> TypeM SrcLoc -> TypeM (TypeExp (ExpBase NoInfo VName) VName)
forall a b. TypeM (a -> b) -> TypeM a -> TypeM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SrcLoc -> TypeM SrcLoc
forall a. a -> TypeM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
loc
    f (TEArray SizeExp (ExpBase NoInfo Name)
size TypeExp (ExpBase NoInfo Name) Name
te SrcLoc
loc) =
      SizeExp (ExpBase NoInfo VName)
-> TypeExp (ExpBase NoInfo VName) VName
-> SrcLoc
-> TypeExp (ExpBase NoInfo VName) VName
forall d vn. SizeExp d -> TypeExp d vn -> SrcLoc -> TypeExp d vn
TEArray (SizeExp (ExpBase NoInfo VName)
 -> TypeExp (ExpBase NoInfo VName) VName
 -> SrcLoc
 -> TypeExp (ExpBase NoInfo VName) VName)
-> TypeM (SizeExp (ExpBase NoInfo VName))
-> TypeM
     (TypeExp (ExpBase NoInfo VName) VName
      -> SrcLoc -> TypeExp (ExpBase NoInfo VName) VName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SizeExp (ExpBase NoInfo Name)
-> TypeM (SizeExp (ExpBase NoInfo VName))
resolveSizeExp SizeExp (ExpBase NoInfo Name)
size TypeM
  (TypeExp (ExpBase NoInfo VName) VName
   -> SrcLoc -> TypeExp (ExpBase NoInfo VName) VName)
-> TypeM (TypeExp (ExpBase NoInfo VName) VName)
-> TypeM (SrcLoc -> TypeExp (ExpBase NoInfo VName) VName)
forall a b. TypeM (a -> b) -> TypeM a -> TypeM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TypeExp (ExpBase NoInfo Name) Name
-> TypeM (TypeExp (ExpBase NoInfo VName) VName)
f TypeExp (ExpBase NoInfo Name) Name
te TypeM (SrcLoc -> TypeExp (ExpBase NoInfo VName) VName)
-> TypeM SrcLoc -> TypeM (TypeExp (ExpBase NoInfo VName) VName)
forall a b. TypeM (a -> b) -> TypeM a -> TypeM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SrcLoc -> TypeM SrcLoc
forall a. a -> TypeM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
loc

-- | Resolve names in a single expression.
resolveExp :: ExpBase NoInfo Name -> TypeM (ExpBase NoInfo VName)
--
-- First all the trivial cases.
resolveExp :: ExpBase NoInfo Name -> TypeM (ExpBase NoInfo VName)
resolveExp (Literal PrimValue
x SrcLoc
loc) = ExpBase NoInfo VName -> TypeM (ExpBase NoInfo VName)
forall a. a -> TypeM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ExpBase NoInfo VName -> TypeM (ExpBase NoInfo VName))
-> ExpBase NoInfo VName -> TypeM (ExpBase NoInfo VName)
forall a b. (a -> b) -> a -> b
$ PrimValue -> SrcLoc -> ExpBase NoInfo VName
forall (f :: * -> *) vn. PrimValue -> SrcLoc -> ExpBase f vn
Literal PrimValue
x SrcLoc
loc
resolveExp (IntLit Integer
x NoInfo StructType
NoInfo SrcLoc
loc) = ExpBase NoInfo VName -> TypeM (ExpBase NoInfo VName)
forall a. a -> TypeM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ExpBase NoInfo VName -> TypeM (ExpBase NoInfo VName))
-> ExpBase NoInfo VName -> TypeM (ExpBase NoInfo VName)
forall a b. (a -> b) -> a -> b
$ Integer -> NoInfo StructType -> SrcLoc -> ExpBase NoInfo VName
forall (f :: * -> *) vn.
Integer -> f StructType -> SrcLoc -> ExpBase f vn
IntLit Integer
x NoInfo StructType
forall {k} (a :: k). NoInfo a
NoInfo SrcLoc
loc
resolveExp (FloatLit Double
x NoInfo StructType
NoInfo SrcLoc
loc) = ExpBase NoInfo VName -> TypeM (ExpBase NoInfo VName)
forall a. a -> TypeM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ExpBase NoInfo VName -> TypeM (ExpBase NoInfo VName))
-> ExpBase NoInfo VName -> TypeM (ExpBase NoInfo VName)
forall a b. (a -> b) -> a -> b
$ Double -> NoInfo StructType -> SrcLoc -> ExpBase NoInfo VName
forall (f :: * -> *) vn.
Double -> f StructType -> SrcLoc -> ExpBase f vn
FloatLit Double
x NoInfo StructType
forall {k} (a :: k). NoInfo a
NoInfo SrcLoc
loc
resolveExp (StringLit [Word8]
x SrcLoc
loc) = ExpBase NoInfo VName -> TypeM (ExpBase NoInfo VName)
forall a. a -> TypeM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ExpBase NoInfo VName -> TypeM (ExpBase NoInfo VName))
-> ExpBase NoInfo VName -> TypeM (ExpBase NoInfo VName)
forall a b. (a -> b) -> a -> b
$ [Word8] -> SrcLoc -> ExpBase NoInfo VName
forall (f :: * -> *) vn. [Word8] -> SrcLoc -> ExpBase f vn
StringLit [Word8]
x SrcLoc
loc
resolveExp (Hole NoInfo StructType
NoInfo SrcLoc
loc) = ExpBase NoInfo VName -> TypeM (ExpBase NoInfo VName)
forall a. a -> TypeM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ExpBase NoInfo VName -> TypeM (ExpBase NoInfo VName))
-> ExpBase NoInfo VName -> TypeM (ExpBase NoInfo VName)
forall a b. (a -> b) -> a -> b
$ NoInfo StructType -> SrcLoc -> ExpBase NoInfo VName
forall (f :: * -> *) vn. f StructType -> SrcLoc -> ExpBase f vn
Hole NoInfo StructType
forall {k} (a :: k). NoInfo a
NoInfo SrcLoc
loc
--
-- The main interesting cases (except for the ones in AppExp).
resolveExp (Var QualName Name
qn NoInfo StructType
NoInfo SrcLoc
loc) = do
  -- The qualifiers of a variable is divided into two parts: first a
  -- possibly-empty sequence of module qualifiers, followed by a
  -- possible-empty sequence of record field accesses.  We use scope
  -- information to perform the split, by taking qualifiers off the
  -- end until we find something that is not a module.
  (QualName VName
qn', [Name]
fields) <- [Name] -> Name -> TypeM (QualName VName, [Name])
findRootVar (QualName Name -> [Name]
forall vn. QualName vn -> [vn]
qualQuals QualName Name
qn) (QualName Name -> Name
forall vn. QualName vn -> vn
qualLeaf QualName Name
qn)
  Bool -> TypeM () -> TypeM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Text
"_" Text -> Text -> Bool
`T.isPrefixOf` Name -> Text
nameToText (QualName Name -> Name
forall vn. QualName vn -> vn
qualLeaf QualName Name
qn)) (TypeM () -> TypeM ()) -> TypeM () -> TypeM ()
forall a b. (a -> b) -> a -> b
$
    SrcLoc -> QualName Name -> TypeM ()
forall (m :: * -> *) a.
MonadTypeChecker m =>
SrcLoc -> QualName Name -> m a
underscoreUse SrcLoc
loc QualName Name
qn
  ExpBase NoInfo VName -> TypeM (ExpBase NoInfo VName)
forall a. a -> TypeM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ExpBase NoInfo VName -> TypeM (ExpBase NoInfo VName))
-> ExpBase NoInfo VName -> TypeM (ExpBase NoInfo VName)
forall a b. (a -> b) -> a -> b
$ (ExpBase NoInfo VName -> Name -> ExpBase NoInfo VName)
-> ExpBase NoInfo VName -> [Name] -> ExpBase NoInfo VName
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
L.foldl' ExpBase NoInfo VName -> Name -> ExpBase NoInfo VName
forall {vn}. ExpBase NoInfo vn -> Name -> ExpBase NoInfo vn
project (QualName VName
-> NoInfo StructType -> SrcLoc -> ExpBase NoInfo VName
forall (f :: * -> *) vn.
QualName vn -> f StructType -> SrcLoc -> ExpBase f vn
Var QualName VName
qn' NoInfo StructType
forall {k} (a :: k). NoInfo a
NoInfo SrcLoc
loc) [Name]
fields
  where
    findRootVar :: [Name] -> Name -> TypeM (QualName VName, [Name])
findRootVar [Name]
qs Name
name =
      (QualName VName -> (QualName VName, [Name])
forall {a} {a}. a -> (a, [a])
whenFound (QualName VName -> (QualName VName, [Name]))
-> TypeM (QualName VName) -> TypeM (QualName VName, [Name])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> QualName Name -> SrcLoc -> TypeM (QualName VName)
resolveQualName ([Name] -> Name -> QualName Name
forall vn. [vn] -> vn -> QualName vn
QualName [Name]
qs Name
name) SrcLoc
loc)
        TypeM (QualName VName, [Name])
-> (TypeError -> TypeM (QualName VName, [Name]))
-> TypeM (QualName VName, [Name])
forall a. TypeM a -> (TypeError -> TypeM a) -> TypeM a
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
`catchError` [Name] -> Name -> TypeError -> TypeM (QualName VName, [Name])
notFound [Name]
qs Name
name

    whenFound :: a -> (a, [a])
whenFound a
qn' = (a
qn', [])

    notFound :: [Name] -> Name -> TypeError -> TypeM (QualName VName, [Name])
notFound [Name]
qs Name
name TypeError
err
      | [Name] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Name]
qs = TypeError -> TypeM (QualName VName, [Name])
forall a. TypeError -> TypeM a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError TypeError
err
      | Bool
otherwise = do
          (QualName VName
qn', [Name]
fields) <-
            [Name] -> Name -> TypeM (QualName VName, [Name])
findRootVar ([Name] -> [Name]
forall a. HasCallStack => [a] -> [a]
init [Name]
qs) ([Name] -> Name
forall a. HasCallStack => [a] -> a
last [Name]
qs) TypeM (QualName VName, [Name])
-> (TypeError -> TypeM (QualName VName, [Name]))
-> TypeM (QualName VName, [Name])
forall a. TypeM a -> (TypeError -> TypeM a) -> TypeM a
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
`catchError` TypeM (QualName VName, [Name])
-> TypeError -> TypeM (QualName VName, [Name])
forall a b. a -> b -> a
const (TypeError -> TypeM (QualName VName, [Name])
forall a. TypeError -> TypeM a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError TypeError
err)
          (QualName VName, [Name]) -> TypeM (QualName VName, [Name])
forall a. a -> TypeM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (QualName VName
qn', [Name]
fields [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ [Name
name])

    project :: ExpBase NoInfo vn -> Name -> ExpBase NoInfo vn
project ExpBase NoInfo vn
e Name
k = Name
-> ExpBase NoInfo vn
-> NoInfo StructType
-> SrcLoc
-> ExpBase NoInfo vn
forall (f :: * -> *) vn.
Name -> ExpBase f vn -> f StructType -> SrcLoc -> ExpBase f vn
Project Name
k ExpBase NoInfo vn
e NoInfo StructType
forall {k} (a :: k). NoInfo a
NoInfo SrcLoc
loc
--
resolveExp (Lambda [PatBase NoInfo Name ParamType]
params ExpBase NoInfo Name
body Maybe (TypeExp (ExpBase NoInfo Name) Name)
ret NoInfo ResRetType
NoInfo SrcLoc
loc) = do
  [UncheckedTypeParam] -> [PatBase NoInfo Name ParamType] -> TypeM ()
forall (m :: * -> *) t.
MonadTypeChecker m =>
[UncheckedTypeParam] -> [UncheckedPat t] -> m ()
checkForDuplicateNames [] [PatBase NoInfo Name ParamType]
params
  [PatBase NoInfo Name ParamType]
-> ([PatBase NoInfo VName ParamType]
    -> TypeM (ExpBase NoInfo VName))
-> TypeM (ExpBase NoInfo VName)
forall a.
[PatBase NoInfo Name ParamType]
-> ([PatBase NoInfo VName ParamType] -> TypeM a) -> TypeM a
resolveParams [PatBase NoInfo Name ParamType]
params (([PatBase NoInfo VName ParamType] -> TypeM (ExpBase NoInfo VName))
 -> TypeM (ExpBase NoInfo VName))
-> ([PatBase NoInfo VName ParamType]
    -> TypeM (ExpBase NoInfo VName))
-> TypeM (ExpBase NoInfo VName)
forall a b. (a -> b) -> a -> b
$ \[PatBase NoInfo VName ParamType]
params' -> do
    ExpBase NoInfo VName
body' <- ExpBase NoInfo Name -> TypeM (ExpBase NoInfo VName)
resolveExp ExpBase NoInfo Name
body
    Maybe (TypeExp (ExpBase NoInfo VName) VName)
ret' <- (TypeExp (ExpBase NoInfo Name) Name
 -> TypeM (TypeExp (ExpBase NoInfo VName) VName))
-> Maybe (TypeExp (ExpBase NoInfo Name) Name)
-> TypeM (Maybe (TypeExp (ExpBase NoInfo VName) VName))
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) -> Maybe a -> f (Maybe b)
traverse TypeExp (ExpBase NoInfo Name) Name
-> TypeM (TypeExp (ExpBase NoInfo VName) VName)
resolveTypeExp Maybe (TypeExp (ExpBase NoInfo Name) Name)
ret
    ExpBase NoInfo VName -> TypeM (ExpBase NoInfo VName)
forall a. a -> TypeM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ExpBase NoInfo VName -> TypeM (ExpBase NoInfo VName))
-> ExpBase NoInfo VName -> TypeM (ExpBase NoInfo VName)
forall a b. (a -> b) -> a -> b
$ [PatBase NoInfo VName ParamType]
-> ExpBase NoInfo VName
-> Maybe (TypeExp (ExpBase NoInfo VName) VName)
-> NoInfo ResRetType
-> SrcLoc
-> ExpBase NoInfo VName
forall (f :: * -> *) vn.
[PatBase f vn ParamType]
-> ExpBase f vn
-> Maybe (TypeExp (ExpBase f vn) vn)
-> f ResRetType
-> SrcLoc
-> ExpBase f vn
Lambda [PatBase NoInfo VName ParamType]
params' ExpBase NoInfo VName
body' Maybe (TypeExp (ExpBase NoInfo VName) VName)
ret' NoInfo ResRetType
forall {k} (a :: k). NoInfo a
NoInfo SrcLoc
loc
--
resolveExp (QualParens (QualName Name
modname, SrcLoc
modnameloc) ExpBase NoInfo Name
e SrcLoc
loc) = do
  (QualName VName
modname', Mod
mod) <- SrcLoc -> QualName Name -> TypeM (QualName VName, Mod)
lookupMod SrcLoc
loc QualName Name
modname
  case Mod
mod of
    ModEnv Env
env -> Env -> TypeM (ExpBase NoInfo VName) -> TypeM (ExpBase NoInfo VName)
forall a. Env -> TypeM a -> TypeM a
localEnv (QualName VName -> Env -> Env
qualifyEnv QualName VName
modname' Env
env) (TypeM (ExpBase NoInfo VName) -> TypeM (ExpBase NoInfo VName))
-> TypeM (ExpBase NoInfo VName) -> TypeM (ExpBase NoInfo VName)
forall a b. (a -> b) -> a -> b
$ do
      ExpBase NoInfo VName
e' <- ExpBase NoInfo Name -> TypeM (ExpBase NoInfo VName)
resolveExp ExpBase NoInfo Name
e
      ExpBase NoInfo VName -> TypeM (ExpBase NoInfo VName)
forall a. a -> TypeM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ExpBase NoInfo VName -> TypeM (ExpBase NoInfo VName))
-> ExpBase NoInfo VName -> TypeM (ExpBase NoInfo VName)
forall a b. (a -> b) -> a -> b
$ (QualName VName, SrcLoc)
-> ExpBase NoInfo VName -> SrcLoc -> ExpBase NoInfo VName
forall (f :: * -> *) vn.
(QualName vn, SrcLoc) -> ExpBase f vn -> SrcLoc -> ExpBase f vn
QualParens (QualName VName
modname', SrcLoc
modnameloc) ExpBase NoInfo VName
e' SrcLoc
loc
    ModFun {} ->
      SrcLoc -> Notes -> Doc () -> TypeM (ExpBase NoInfo VName)
forall loc a. Located loc => loc -> Notes -> Doc () -> TypeM a
forall (m :: * -> *) loc a.
(MonadTypeChecker m, Located loc) =>
loc -> Notes -> Doc () -> m a
typeError SrcLoc
loc Notes
forall a. Monoid a => a
mempty (Doc () -> TypeM (ExpBase NoInfo VName))
-> (Doc () -> Doc ()) -> Doc () -> TypeM (ExpBase NoInfo VName)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc () -> Doc () -> Doc ()
forall a. Doc a -> Doc a -> Doc a
withIndexLink Doc ()
"module-is-parametric" (Doc () -> TypeM (ExpBase NoInfo VName))
-> Doc () -> TypeM (ExpBase NoInfo VName)
forall a b. (a -> b) -> a -> b
$
        Doc ()
"Module" Doc () -> Doc () -> Doc ()
forall a. Doc a -> Doc a -> Doc a
<+> QualName Name -> Doc ()
forall a ann. Pretty a => a -> Doc ann
forall ann. QualName Name -> Doc ann
pretty QualName Name
modname Doc () -> Doc () -> Doc ()
forall a. Doc a -> Doc a -> Doc a
<+> Doc ()
" is a parametric module."
  where
    qualifyEnv :: QualName VName -> Env -> Env
qualifyEnv QualName VName
modname' Env
env =
      Env
env {envNameMap = qualify' modname' <$> envNameMap env}
    qualify' :: QualName vn -> QualName vn -> QualName vn
qualify' QualName vn
modname' (QualName [vn]
qs vn
name) =
      [vn] -> vn -> QualName vn
forall vn. [vn] -> vn -> QualName vn
QualName (QualName vn -> [vn]
forall vn. QualName vn -> [vn]
qualQuals QualName vn
modname' [vn] -> [vn] -> [vn]
forall a. [a] -> [a] -> [a]
++ [QualName vn -> vn
forall vn. QualName vn -> vn
qualLeaf QualName vn
modname'] [vn] -> [vn] -> [vn]
forall a. [a] -> [a] -> [a]
++ [vn]
qs) vn
name

--
-- The tedious recursive cases.
resolveExp (Parens ExpBase NoInfo Name
e SrcLoc
loc) =
  ExpBase NoInfo VName -> SrcLoc -> ExpBase NoInfo VName
forall (f :: * -> *) vn. ExpBase f vn -> SrcLoc -> ExpBase f vn
Parens (ExpBase NoInfo VName -> SrcLoc -> ExpBase NoInfo VName)
-> TypeM (ExpBase NoInfo VName)
-> TypeM (SrcLoc -> ExpBase NoInfo VName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ExpBase NoInfo Name -> TypeM (ExpBase NoInfo VName)
resolveExp ExpBase NoInfo Name
e TypeM (SrcLoc -> ExpBase NoInfo VName)
-> TypeM SrcLoc -> TypeM (ExpBase NoInfo VName)
forall a b. TypeM (a -> b) -> TypeM a -> TypeM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SrcLoc -> TypeM SrcLoc
forall a. a -> TypeM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
loc
resolveExp (Attr AttrInfo Name
attr ExpBase NoInfo Name
e SrcLoc
loc) =
  AttrInfo VName
-> ExpBase NoInfo VName -> SrcLoc -> ExpBase NoInfo VName
forall (f :: * -> *) vn.
AttrInfo vn -> ExpBase f vn -> SrcLoc -> ExpBase f vn
Attr (AttrInfo VName
 -> ExpBase NoInfo VName -> SrcLoc -> ExpBase NoInfo VName)
-> TypeM (AttrInfo VName)
-> TypeM (ExpBase NoInfo VName -> SrcLoc -> ExpBase NoInfo VName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AttrInfo Name -> TypeM (AttrInfo VName)
resolveAttrInfo AttrInfo Name
attr TypeM (ExpBase NoInfo VName -> SrcLoc -> ExpBase NoInfo VName)
-> TypeM (ExpBase NoInfo VName)
-> TypeM (SrcLoc -> ExpBase NoInfo VName)
forall a b. TypeM (a -> b) -> TypeM a -> TypeM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ExpBase NoInfo Name -> TypeM (ExpBase NoInfo VName)
resolveExp ExpBase NoInfo Name
e TypeM (SrcLoc -> ExpBase NoInfo VName)
-> TypeM SrcLoc -> TypeM (ExpBase NoInfo VName)
forall a b. TypeM (a -> b) -> TypeM a -> TypeM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SrcLoc -> TypeM SrcLoc
forall a. a -> TypeM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
loc
resolveExp (TupLit [ExpBase NoInfo Name]
es SrcLoc
loc) =
  [ExpBase NoInfo VName] -> SrcLoc -> ExpBase NoInfo VName
forall (f :: * -> *) vn. [ExpBase f vn] -> SrcLoc -> ExpBase f vn
TupLit ([ExpBase NoInfo VName] -> SrcLoc -> ExpBase NoInfo VName)
-> TypeM [ExpBase NoInfo VName]
-> TypeM (SrcLoc -> ExpBase NoInfo VName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ExpBase NoInfo Name -> TypeM (ExpBase NoInfo VName))
-> [ExpBase NoInfo Name] -> TypeM [ExpBase NoInfo VName]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ExpBase NoInfo Name -> TypeM (ExpBase NoInfo VName)
resolveExp [ExpBase NoInfo Name]
es TypeM (SrcLoc -> ExpBase NoInfo VName)
-> TypeM SrcLoc -> TypeM (ExpBase NoInfo VName)
forall a b. TypeM (a -> b) -> TypeM a -> TypeM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SrcLoc -> TypeM SrcLoc
forall a. a -> TypeM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
loc
resolveExp (ArrayLit [ExpBase NoInfo Name]
es NoInfo StructType
NoInfo SrcLoc
loc) =
  [ExpBase NoInfo VName]
-> NoInfo StructType -> SrcLoc -> ExpBase NoInfo VName
forall (f :: * -> *) vn.
[ExpBase f vn] -> f StructType -> SrcLoc -> ExpBase f vn
ArrayLit ([ExpBase NoInfo VName]
 -> NoInfo StructType -> SrcLoc -> ExpBase NoInfo VName)
-> TypeM [ExpBase NoInfo VName]
-> TypeM (NoInfo StructType -> SrcLoc -> ExpBase NoInfo VName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ExpBase NoInfo Name -> TypeM (ExpBase NoInfo VName))
-> [ExpBase NoInfo Name] -> TypeM [ExpBase NoInfo VName]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ExpBase NoInfo Name -> TypeM (ExpBase NoInfo VName)
resolveExp [ExpBase NoInfo Name]
es TypeM (NoInfo StructType -> SrcLoc -> ExpBase NoInfo VName)
-> TypeM (NoInfo StructType)
-> TypeM (SrcLoc -> ExpBase NoInfo VName)
forall a b. TypeM (a -> b) -> TypeM a -> TypeM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> NoInfo StructType -> TypeM (NoInfo StructType)
forall a. a -> TypeM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure NoInfo StructType
forall {k} (a :: k). NoInfo a
NoInfo TypeM (SrcLoc -> ExpBase NoInfo VName)
-> TypeM SrcLoc -> TypeM (ExpBase NoInfo VName)
forall a b. TypeM (a -> b) -> TypeM a -> TypeM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SrcLoc -> TypeM SrcLoc
forall a. a -> TypeM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
loc
resolveExp (Negate ExpBase NoInfo Name
e SrcLoc
loc) =
  ExpBase NoInfo VName -> SrcLoc -> ExpBase NoInfo VName
forall (f :: * -> *) vn. ExpBase f vn -> SrcLoc -> ExpBase f vn
Negate (ExpBase NoInfo VName -> SrcLoc -> ExpBase NoInfo VName)
-> TypeM (ExpBase NoInfo VName)
-> TypeM (SrcLoc -> ExpBase NoInfo VName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ExpBase NoInfo Name -> TypeM (ExpBase NoInfo VName)
resolveExp ExpBase NoInfo Name
e TypeM (SrcLoc -> ExpBase NoInfo VName)
-> TypeM SrcLoc -> TypeM (ExpBase NoInfo VName)
forall a b. TypeM (a -> b) -> TypeM a -> TypeM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SrcLoc -> TypeM SrcLoc
forall a. a -> TypeM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
loc
resolveExp (Not ExpBase NoInfo Name
e SrcLoc
loc) =
  ExpBase NoInfo VName -> SrcLoc -> ExpBase NoInfo VName
forall (f :: * -> *) vn. ExpBase f vn -> SrcLoc -> ExpBase f vn
Not (ExpBase NoInfo VName -> SrcLoc -> ExpBase NoInfo VName)
-> TypeM (ExpBase NoInfo VName)
-> TypeM (SrcLoc -> ExpBase NoInfo VName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ExpBase NoInfo Name -> TypeM (ExpBase NoInfo VName)
resolveExp ExpBase NoInfo Name
e TypeM (SrcLoc -> ExpBase NoInfo VName)
-> TypeM SrcLoc -> TypeM (ExpBase NoInfo VName)
forall a b. TypeM (a -> b) -> TypeM a -> TypeM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SrcLoc -> TypeM SrcLoc
forall a. a -> TypeM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
loc
resolveExp (Assert ExpBase NoInfo Name
e1 ExpBase NoInfo Name
e2 NoInfo Text
NoInfo SrcLoc
loc) =
  ExpBase NoInfo VName
-> ExpBase NoInfo VName
-> NoInfo Text
-> SrcLoc
-> ExpBase NoInfo VName
forall (f :: * -> *) vn.
ExpBase f vn -> ExpBase f vn -> f Text -> SrcLoc -> ExpBase f vn
Assert (ExpBase NoInfo VName
 -> ExpBase NoInfo VName
 -> NoInfo Text
 -> SrcLoc
 -> ExpBase NoInfo VName)
-> TypeM (ExpBase NoInfo VName)
-> TypeM
     (ExpBase NoInfo VName
      -> NoInfo Text -> SrcLoc -> ExpBase NoInfo VName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ExpBase NoInfo Name -> TypeM (ExpBase NoInfo VName)
resolveExp ExpBase NoInfo Name
e1 TypeM
  (ExpBase NoInfo VName
   -> NoInfo Text -> SrcLoc -> ExpBase NoInfo VName)
-> TypeM (ExpBase NoInfo VName)
-> TypeM (NoInfo Text -> SrcLoc -> ExpBase NoInfo VName)
forall a b. TypeM (a -> b) -> TypeM a -> TypeM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ExpBase NoInfo Name -> TypeM (ExpBase NoInfo VName)
resolveExp ExpBase NoInfo Name
e2 TypeM (NoInfo Text -> SrcLoc -> ExpBase NoInfo VName)
-> TypeM (NoInfo Text) -> TypeM (SrcLoc -> ExpBase NoInfo VName)
forall a b. TypeM (a -> b) -> TypeM a -> TypeM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> NoInfo Text -> TypeM (NoInfo Text)
forall a. a -> TypeM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure NoInfo Text
forall {k} (a :: k). NoInfo a
NoInfo TypeM (SrcLoc -> ExpBase NoInfo VName)
-> TypeM SrcLoc -> TypeM (ExpBase NoInfo VName)
forall a b. TypeM (a -> b) -> TypeM a -> TypeM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SrcLoc -> TypeM SrcLoc
forall a. a -> TypeM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
loc
resolveExp (RecordLit [FieldBase NoInfo Name]
fs SrcLoc
loc) =
  [FieldBase NoInfo VName] -> SrcLoc -> ExpBase NoInfo VName
forall (f :: * -> *) vn. [FieldBase f vn] -> SrcLoc -> ExpBase f vn
RecordLit ([FieldBase NoInfo VName] -> SrcLoc -> ExpBase NoInfo VName)
-> TypeM [FieldBase NoInfo VName]
-> TypeM (SrcLoc -> ExpBase NoInfo VName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FieldBase NoInfo Name -> TypeM (FieldBase NoInfo VName))
-> [FieldBase NoInfo Name] -> TypeM [FieldBase NoInfo VName]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM FieldBase NoInfo Name -> TypeM (FieldBase NoInfo VName)
resolveField [FieldBase NoInfo Name]
fs TypeM (SrcLoc -> ExpBase NoInfo VName)
-> TypeM SrcLoc -> TypeM (ExpBase NoInfo VName)
forall a b. TypeM (a -> b) -> TypeM a -> TypeM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SrcLoc -> TypeM SrcLoc
forall a. a -> TypeM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
loc
  where
    resolveField :: FieldBase NoInfo Name -> TypeM (FieldBase NoInfo VName)
resolveField (RecordFieldExplicit Name
k ExpBase NoInfo Name
e SrcLoc
floc) =
      Name -> ExpBase NoInfo VName -> SrcLoc -> FieldBase NoInfo VName
forall (f :: * -> *) vn.
Name -> ExpBase f vn -> SrcLoc -> FieldBase f vn
RecordFieldExplicit Name
k (ExpBase NoInfo VName -> SrcLoc -> FieldBase NoInfo VName)
-> TypeM (ExpBase NoInfo VName)
-> TypeM (SrcLoc -> FieldBase NoInfo VName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ExpBase NoInfo Name -> TypeM (ExpBase NoInfo VName)
resolveExp ExpBase NoInfo Name
e TypeM (SrcLoc -> FieldBase NoInfo VName)
-> TypeM SrcLoc -> TypeM (FieldBase NoInfo VName)
forall a b. TypeM (a -> b) -> TypeM a -> TypeM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SrcLoc -> TypeM SrcLoc
forall a. a -> TypeM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
floc
    resolveField (RecordFieldImplicit Name
vn NoInfo StructType
NoInfo SrcLoc
floc) =
      VName -> NoInfo StructType -> SrcLoc -> FieldBase NoInfo VName
forall (f :: * -> *) vn.
vn -> f StructType -> SrcLoc -> FieldBase f vn
RecordFieldImplicit (VName -> NoInfo StructType -> SrcLoc -> FieldBase NoInfo VName)
-> TypeM VName
-> TypeM (NoInfo StructType -> SrcLoc -> FieldBase NoInfo VName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Name -> SrcLoc -> TypeM VName
resolveName Name
vn SrcLoc
floc TypeM (NoInfo StructType -> SrcLoc -> FieldBase NoInfo VName)
-> TypeM (NoInfo StructType)
-> TypeM (SrcLoc -> FieldBase NoInfo VName)
forall a b. TypeM (a -> b) -> TypeM a -> TypeM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> NoInfo StructType -> TypeM (NoInfo StructType)
forall a. a -> TypeM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure NoInfo StructType
forall {k} (a :: k). NoInfo a
NoInfo TypeM (SrcLoc -> FieldBase NoInfo VName)
-> TypeM SrcLoc -> TypeM (FieldBase NoInfo VName)
forall a b. TypeM (a -> b) -> TypeM a -> TypeM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SrcLoc -> TypeM SrcLoc
forall a. a -> TypeM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
floc
resolveExp (Project Name
k ExpBase NoInfo Name
e NoInfo StructType
NoInfo SrcLoc
loc) =
  Name
-> ExpBase NoInfo VName
-> NoInfo StructType
-> SrcLoc
-> ExpBase NoInfo VName
forall (f :: * -> *) vn.
Name -> ExpBase f vn -> f StructType -> SrcLoc -> ExpBase f vn
Project Name
k (ExpBase NoInfo VName
 -> NoInfo StructType -> SrcLoc -> ExpBase NoInfo VName)
-> TypeM (ExpBase NoInfo VName)
-> TypeM (NoInfo StructType -> SrcLoc -> ExpBase NoInfo VName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ExpBase NoInfo Name -> TypeM (ExpBase NoInfo VName)
resolveExp ExpBase NoInfo Name
e TypeM (NoInfo StructType -> SrcLoc -> ExpBase NoInfo VName)
-> TypeM (NoInfo StructType)
-> TypeM (SrcLoc -> ExpBase NoInfo VName)
forall a b. TypeM (a -> b) -> TypeM a -> TypeM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> NoInfo StructType -> TypeM (NoInfo StructType)
forall a. a -> TypeM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure NoInfo StructType
forall {k} (a :: k). NoInfo a
NoInfo TypeM (SrcLoc -> ExpBase NoInfo VName)
-> TypeM SrcLoc -> TypeM (ExpBase NoInfo VName)
forall a b. TypeM (a -> b) -> TypeM a -> TypeM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SrcLoc -> TypeM SrcLoc
forall a. a -> TypeM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
loc
resolveExp (Constr Name
k [ExpBase NoInfo Name]
es NoInfo StructType
NoInfo SrcLoc
loc) =
  Name
-> [ExpBase NoInfo VName]
-> NoInfo StructType
-> SrcLoc
-> ExpBase NoInfo VName
forall (f :: * -> *) vn.
Name -> [ExpBase f vn] -> f StructType -> SrcLoc -> ExpBase f vn
Constr Name
k ([ExpBase NoInfo VName]
 -> NoInfo StructType -> SrcLoc -> ExpBase NoInfo VName)
-> TypeM [ExpBase NoInfo VName]
-> TypeM (NoInfo StructType -> SrcLoc -> ExpBase NoInfo VName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ExpBase NoInfo Name -> TypeM (ExpBase NoInfo VName))
-> [ExpBase NoInfo Name] -> TypeM [ExpBase NoInfo VName]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ExpBase NoInfo Name -> TypeM (ExpBase NoInfo VName)
resolveExp [ExpBase NoInfo Name]
es TypeM (NoInfo StructType -> SrcLoc -> ExpBase NoInfo VName)
-> TypeM (NoInfo StructType)
-> TypeM (SrcLoc -> ExpBase NoInfo VName)
forall a b. TypeM (a -> b) -> TypeM a -> TypeM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> NoInfo StructType -> TypeM (NoInfo StructType)
forall a. a -> TypeM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure NoInfo StructType
forall {k} (a :: k). NoInfo a
NoInfo TypeM (SrcLoc -> ExpBase NoInfo VName)
-> TypeM SrcLoc -> TypeM (ExpBase NoInfo VName)
forall a b. TypeM (a -> b) -> TypeM a -> TypeM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SrcLoc -> TypeM SrcLoc
forall a. a -> TypeM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
loc
resolveExp (Update ExpBase NoInfo Name
e1 SliceBase NoInfo Name
slice ExpBase NoInfo Name
e2 SrcLoc
loc) =
  ExpBase NoInfo VName
-> SliceBase NoInfo VName
-> ExpBase NoInfo VName
-> SrcLoc
-> ExpBase NoInfo VName
forall (f :: * -> *) vn.
ExpBase f vn
-> SliceBase f vn -> ExpBase f vn -> SrcLoc -> ExpBase f vn
Update (ExpBase NoInfo VName
 -> SliceBase NoInfo VName
 -> ExpBase NoInfo VName
 -> SrcLoc
 -> ExpBase NoInfo VName)
-> TypeM (ExpBase NoInfo VName)
-> TypeM
     (SliceBase NoInfo VName
      -> ExpBase NoInfo VName -> SrcLoc -> ExpBase NoInfo VName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ExpBase NoInfo Name -> TypeM (ExpBase NoInfo VName)
resolveExp ExpBase NoInfo Name
e1 TypeM
  (SliceBase NoInfo VName
   -> ExpBase NoInfo VName -> SrcLoc -> ExpBase NoInfo VName)
-> TypeM (SliceBase NoInfo VName)
-> TypeM (ExpBase NoInfo VName -> SrcLoc -> ExpBase NoInfo VName)
forall a b. TypeM (a -> b) -> TypeM a -> TypeM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SliceBase NoInfo Name -> TypeM (SliceBase NoInfo VName)
resolveSlice SliceBase NoInfo Name
slice TypeM (ExpBase NoInfo VName -> SrcLoc -> ExpBase NoInfo VName)
-> TypeM (ExpBase NoInfo VName)
-> TypeM (SrcLoc -> ExpBase NoInfo VName)
forall a b. TypeM (a -> b) -> TypeM a -> TypeM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ExpBase NoInfo Name -> TypeM (ExpBase NoInfo VName)
resolveExp ExpBase NoInfo Name
e2 TypeM (SrcLoc -> ExpBase NoInfo VName)
-> TypeM SrcLoc -> TypeM (ExpBase NoInfo VName)
forall a b. TypeM (a -> b) -> TypeM a -> TypeM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SrcLoc -> TypeM SrcLoc
forall a. a -> TypeM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
loc
resolveExp (RecordUpdate ExpBase NoInfo Name
e1 [Name]
fs ExpBase NoInfo Name
e2 NoInfo StructType
NoInfo SrcLoc
loc) =
  ExpBase NoInfo VName
-> [Name]
-> ExpBase NoInfo VName
-> NoInfo StructType
-> SrcLoc
-> ExpBase NoInfo VName
forall (f :: * -> *) vn.
ExpBase f vn
-> [Name] -> ExpBase f vn -> f StructType -> SrcLoc -> ExpBase f vn
RecordUpdate (ExpBase NoInfo VName
 -> [Name]
 -> ExpBase NoInfo VName
 -> NoInfo StructType
 -> SrcLoc
 -> ExpBase NoInfo VName)
-> TypeM (ExpBase NoInfo VName)
-> TypeM
     ([Name]
      -> ExpBase NoInfo VName
      -> NoInfo StructType
      -> SrcLoc
      -> ExpBase NoInfo VName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ExpBase NoInfo Name -> TypeM (ExpBase NoInfo VName)
resolveExp ExpBase NoInfo Name
e1 TypeM
  ([Name]
   -> ExpBase NoInfo VName
   -> NoInfo StructType
   -> SrcLoc
   -> ExpBase NoInfo VName)
-> TypeM [Name]
-> TypeM
     (ExpBase NoInfo VName
      -> NoInfo StructType -> SrcLoc -> ExpBase NoInfo VName)
forall a b. TypeM (a -> b) -> TypeM a -> TypeM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Name] -> TypeM [Name]
forall a. a -> TypeM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Name]
fs TypeM
  (ExpBase NoInfo VName
   -> NoInfo StructType -> SrcLoc -> ExpBase NoInfo VName)
-> TypeM (ExpBase NoInfo VName)
-> TypeM (NoInfo StructType -> SrcLoc -> ExpBase NoInfo VName)
forall a b. TypeM (a -> b) -> TypeM a -> TypeM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ExpBase NoInfo Name -> TypeM (ExpBase NoInfo VName)
resolveExp ExpBase NoInfo Name
e2 TypeM (NoInfo StructType -> SrcLoc -> ExpBase NoInfo VName)
-> TypeM (NoInfo StructType)
-> TypeM (SrcLoc -> ExpBase NoInfo VName)
forall a b. TypeM (a -> b) -> TypeM a -> TypeM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> NoInfo StructType -> TypeM (NoInfo StructType)
forall a. a -> TypeM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure NoInfo StructType
forall {k} (a :: k). NoInfo a
NoInfo TypeM (SrcLoc -> ExpBase NoInfo VName)
-> TypeM SrcLoc -> TypeM (ExpBase NoInfo VName)
forall a b. TypeM (a -> b) -> TypeM a -> TypeM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SrcLoc -> TypeM SrcLoc
forall a. a -> TypeM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
loc
resolveExp (OpSection QualName Name
v NoInfo StructType
NoInfo SrcLoc
loc) =
  QualName VName
-> NoInfo StructType -> SrcLoc -> ExpBase NoInfo VName
forall (f :: * -> *) vn.
QualName vn -> f StructType -> SrcLoc -> ExpBase f vn
OpSection (QualName VName
 -> NoInfo StructType -> SrcLoc -> ExpBase NoInfo VName)
-> TypeM (QualName VName)
-> TypeM (NoInfo StructType -> SrcLoc -> ExpBase NoInfo VName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> QualName Name -> SrcLoc -> TypeM (QualName VName)
resolveQualName QualName Name
v SrcLoc
loc TypeM (NoInfo StructType -> SrcLoc -> ExpBase NoInfo VName)
-> TypeM (NoInfo StructType)
-> TypeM (SrcLoc -> ExpBase NoInfo VName)
forall a b. TypeM (a -> b) -> TypeM a -> TypeM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> NoInfo StructType -> TypeM (NoInfo StructType)
forall a. a -> TypeM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure NoInfo StructType
forall {k} (a :: k). NoInfo a
NoInfo TypeM (SrcLoc -> ExpBase NoInfo VName)
-> TypeM SrcLoc -> TypeM (ExpBase NoInfo VName)
forall a b. TypeM (a -> b) -> TypeM a -> TypeM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SrcLoc -> TypeM SrcLoc
forall a. a -> TypeM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
loc
resolveExp (OpSectionLeft QualName Name
v NoInfo StructType
info1 ExpBase NoInfo Name
e (NoInfo (PName, ParamType, Maybe VName), NoInfo (PName, ParamType))
info2 (NoInfo ResRetType, NoInfo [VName])
info3 SrcLoc
loc) =
  QualName VName
-> NoInfo StructType
-> ExpBase NoInfo VName
-> (NoInfo (PName, ParamType, Maybe VName),
    NoInfo (PName, ParamType))
-> (NoInfo ResRetType, NoInfo [VName])
-> SrcLoc
-> ExpBase NoInfo VName
forall (f :: * -> *) vn.
QualName vn
-> f StructType
-> ExpBase f vn
-> (f (PName, ParamType, Maybe VName), f (PName, ParamType))
-> (f ResRetType, f [VName])
-> SrcLoc
-> ExpBase f vn
OpSectionLeft
    (QualName VName
 -> NoInfo StructType
 -> ExpBase NoInfo VName
 -> (NoInfo (PName, ParamType, Maybe VName),
     NoInfo (PName, ParamType))
 -> (NoInfo ResRetType, NoInfo [VName])
 -> SrcLoc
 -> ExpBase NoInfo VName)
-> TypeM (QualName VName)
-> TypeM
     (NoInfo StructType
      -> ExpBase NoInfo VName
      -> (NoInfo (PName, ParamType, Maybe VName),
          NoInfo (PName, ParamType))
      -> (NoInfo ResRetType, NoInfo [VName])
      -> SrcLoc
      -> ExpBase NoInfo VName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> QualName Name -> SrcLoc -> TypeM (QualName VName)
resolveQualName QualName Name
v SrcLoc
loc
    TypeM
  (NoInfo StructType
   -> ExpBase NoInfo VName
   -> (NoInfo (PName, ParamType, Maybe VName),
       NoInfo (PName, ParamType))
   -> (NoInfo ResRetType, NoInfo [VName])
   -> SrcLoc
   -> ExpBase NoInfo VName)
-> TypeM (NoInfo StructType)
-> TypeM
     (ExpBase NoInfo VName
      -> (NoInfo (PName, ParamType, Maybe VName),
          NoInfo (PName, ParamType))
      -> (NoInfo ResRetType, NoInfo [VName])
      -> SrcLoc
      -> ExpBase NoInfo VName)
forall a b. TypeM (a -> b) -> TypeM a -> TypeM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> NoInfo StructType -> TypeM (NoInfo StructType)
forall a. a -> TypeM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure NoInfo StructType
info1
    TypeM
  (ExpBase NoInfo VName
   -> (NoInfo (PName, ParamType, Maybe VName),
       NoInfo (PName, ParamType))
   -> (NoInfo ResRetType, NoInfo [VName])
   -> SrcLoc
   -> ExpBase NoInfo VName)
-> TypeM (ExpBase NoInfo VName)
-> TypeM
     ((NoInfo (PName, ParamType, Maybe VName),
       NoInfo (PName, ParamType))
      -> (NoInfo ResRetType, NoInfo [VName])
      -> SrcLoc
      -> ExpBase NoInfo VName)
forall a b. TypeM (a -> b) -> TypeM a -> TypeM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ExpBase NoInfo Name -> TypeM (ExpBase NoInfo VName)
resolveExp ExpBase NoInfo Name
e
    TypeM
  ((NoInfo (PName, ParamType, Maybe VName),
    NoInfo (PName, ParamType))
   -> (NoInfo ResRetType, NoInfo [VName])
   -> SrcLoc
   -> ExpBase NoInfo VName)
-> TypeM
     (NoInfo (PName, ParamType, Maybe VName), NoInfo (PName, ParamType))
-> TypeM
     ((NoInfo ResRetType, NoInfo [VName])
      -> SrcLoc -> ExpBase NoInfo VName)
forall a b. TypeM (a -> b) -> TypeM a -> TypeM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (NoInfo (PName, ParamType, Maybe VName), NoInfo (PName, ParamType))
-> TypeM
     (NoInfo (PName, ParamType, Maybe VName), NoInfo (PName, ParamType))
forall a. a -> TypeM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NoInfo (PName, ParamType, Maybe VName), NoInfo (PName, ParamType))
info2
    TypeM
  ((NoInfo ResRetType, NoInfo [VName])
   -> SrcLoc -> ExpBase NoInfo VName)
-> TypeM (NoInfo ResRetType, NoInfo [VName])
-> TypeM (SrcLoc -> ExpBase NoInfo VName)
forall a b. TypeM (a -> b) -> TypeM a -> TypeM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (NoInfo ResRetType, NoInfo [VName])
-> TypeM (NoInfo ResRetType, NoInfo [VName])
forall a. a -> TypeM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NoInfo ResRetType, NoInfo [VName])
info3
    TypeM (SrcLoc -> ExpBase NoInfo VName)
-> TypeM SrcLoc -> TypeM (ExpBase NoInfo VName)
forall a b. TypeM (a -> b) -> TypeM a -> TypeM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SrcLoc -> TypeM SrcLoc
forall a. a -> TypeM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
loc
resolveExp (OpSectionRight QualName Name
v NoInfo StructType
info1 ExpBase NoInfo Name
e (NoInfo (PName, ParamType), NoInfo (PName, ParamType, Maybe VName))
info2 NoInfo ResRetType
info3 SrcLoc
loc) =
  QualName VName
-> NoInfo StructType
-> ExpBase NoInfo VName
-> (NoInfo (PName, ParamType),
    NoInfo (PName, ParamType, Maybe VName))
-> NoInfo ResRetType
-> SrcLoc
-> ExpBase NoInfo VName
forall (f :: * -> *) vn.
QualName vn
-> f StructType
-> ExpBase f vn
-> (f (PName, ParamType), f (PName, ParamType, Maybe VName))
-> f ResRetType
-> SrcLoc
-> ExpBase f vn
OpSectionRight
    (QualName VName
 -> NoInfo StructType
 -> ExpBase NoInfo VName
 -> (NoInfo (PName, ParamType),
     NoInfo (PName, ParamType, Maybe VName))
 -> NoInfo ResRetType
 -> SrcLoc
 -> ExpBase NoInfo VName)
-> TypeM (QualName VName)
-> TypeM
     (NoInfo StructType
      -> ExpBase NoInfo VName
      -> (NoInfo (PName, ParamType),
          NoInfo (PName, ParamType, Maybe VName))
      -> NoInfo ResRetType
      -> SrcLoc
      -> ExpBase NoInfo VName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> QualName Name -> SrcLoc -> TypeM (QualName VName)
resolveQualName QualName Name
v SrcLoc
loc
    TypeM
  (NoInfo StructType
   -> ExpBase NoInfo VName
   -> (NoInfo (PName, ParamType),
       NoInfo (PName, ParamType, Maybe VName))
   -> NoInfo ResRetType
   -> SrcLoc
   -> ExpBase NoInfo VName)
-> TypeM (NoInfo StructType)
-> TypeM
     (ExpBase NoInfo VName
      -> (NoInfo (PName, ParamType),
          NoInfo (PName, ParamType, Maybe VName))
      -> NoInfo ResRetType
      -> SrcLoc
      -> ExpBase NoInfo VName)
forall a b. TypeM (a -> b) -> TypeM a -> TypeM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> NoInfo StructType -> TypeM (NoInfo StructType)
forall a. a -> TypeM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure NoInfo StructType
info1
    TypeM
  (ExpBase NoInfo VName
   -> (NoInfo (PName, ParamType),
       NoInfo (PName, ParamType, Maybe VName))
   -> NoInfo ResRetType
   -> SrcLoc
   -> ExpBase NoInfo VName)
-> TypeM (ExpBase NoInfo VName)
-> TypeM
     ((NoInfo (PName, ParamType),
       NoInfo (PName, ParamType, Maybe VName))
      -> NoInfo ResRetType -> SrcLoc -> ExpBase NoInfo VName)
forall a b. TypeM (a -> b) -> TypeM a -> TypeM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ExpBase NoInfo Name -> TypeM (ExpBase NoInfo VName)
resolveExp ExpBase NoInfo Name
e
    TypeM
  ((NoInfo (PName, ParamType),
    NoInfo (PName, ParamType, Maybe VName))
   -> NoInfo ResRetType -> SrcLoc -> ExpBase NoInfo VName)
-> TypeM
     (NoInfo (PName, ParamType), NoInfo (PName, ParamType, Maybe VName))
-> TypeM (NoInfo ResRetType -> SrcLoc -> ExpBase NoInfo VName)
forall a b. TypeM (a -> b) -> TypeM a -> TypeM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (NoInfo (PName, ParamType), NoInfo (PName, ParamType, Maybe VName))
-> TypeM
     (NoInfo (PName, ParamType), NoInfo (PName, ParamType, Maybe VName))
forall a. a -> TypeM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NoInfo (PName, ParamType), NoInfo (PName, ParamType, Maybe VName))
info2
    TypeM (NoInfo ResRetType -> SrcLoc -> ExpBase NoInfo VName)
-> TypeM (NoInfo ResRetType)
-> TypeM (SrcLoc -> ExpBase NoInfo VName)
forall a b. TypeM (a -> b) -> TypeM a -> TypeM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> NoInfo ResRetType -> TypeM (NoInfo ResRetType)
forall a. a -> TypeM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure NoInfo ResRetType
info3
    TypeM (SrcLoc -> ExpBase NoInfo VName)
-> TypeM SrcLoc -> TypeM (ExpBase NoInfo VName)
forall a b. TypeM (a -> b) -> TypeM a -> TypeM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SrcLoc -> TypeM SrcLoc
forall a. a -> TypeM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
loc
resolveExp (ProjectSection [Name]
ks NoInfo StructType
info SrcLoc
loc) =
  ExpBase NoInfo VName -> TypeM (ExpBase NoInfo VName)
forall a. a -> TypeM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ExpBase NoInfo VName -> TypeM (ExpBase NoInfo VName))
-> ExpBase NoInfo VName -> TypeM (ExpBase NoInfo VName)
forall a b. (a -> b) -> a -> b
$ [Name] -> NoInfo StructType -> SrcLoc -> ExpBase NoInfo VName
forall (f :: * -> *) vn.
[Name] -> f StructType -> SrcLoc -> ExpBase f vn
ProjectSection [Name]
ks NoInfo StructType
info SrcLoc
loc
resolveExp (IndexSection SliceBase NoInfo Name
slice NoInfo StructType
info SrcLoc
loc) =
  SliceBase NoInfo VName
-> NoInfo StructType -> SrcLoc -> ExpBase NoInfo VName
forall (f :: * -> *) vn.
SliceBase f vn -> f StructType -> SrcLoc -> ExpBase f vn
IndexSection (SliceBase NoInfo VName
 -> NoInfo StructType -> SrcLoc -> ExpBase NoInfo VName)
-> TypeM (SliceBase NoInfo VName)
-> TypeM (NoInfo StructType -> SrcLoc -> ExpBase NoInfo VName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SliceBase NoInfo Name -> TypeM (SliceBase NoInfo VName)
resolveSlice SliceBase NoInfo Name
slice TypeM (NoInfo StructType -> SrcLoc -> ExpBase NoInfo VName)
-> TypeM (NoInfo StructType)
-> TypeM (SrcLoc -> ExpBase NoInfo VName)
forall a b. TypeM (a -> b) -> TypeM a -> TypeM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> NoInfo StructType -> TypeM (NoInfo StructType)
forall a. a -> TypeM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure NoInfo StructType
info TypeM (SrcLoc -> ExpBase NoInfo VName)
-> TypeM SrcLoc -> TypeM (ExpBase NoInfo VName)
forall a b. TypeM (a -> b) -> TypeM a -> TypeM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SrcLoc -> TypeM SrcLoc
forall a. a -> TypeM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
loc
resolveExp (Ascript ExpBase NoInfo Name
e TypeExp (ExpBase NoInfo Name) Name
te SrcLoc
loc) =
  ExpBase NoInfo VName
-> TypeExp (ExpBase NoInfo VName) VName
-> SrcLoc
-> ExpBase NoInfo VName
forall (f :: * -> *) vn.
ExpBase f vn -> TypeExp (ExpBase f vn) vn -> SrcLoc -> ExpBase f vn
Ascript (ExpBase NoInfo VName
 -> TypeExp (ExpBase NoInfo VName) VName
 -> SrcLoc
 -> ExpBase NoInfo VName)
-> TypeM (ExpBase NoInfo VName)
-> TypeM
     (TypeExp (ExpBase NoInfo VName) VName
      -> SrcLoc -> ExpBase NoInfo VName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ExpBase NoInfo Name -> TypeM (ExpBase NoInfo VName)
resolveExp ExpBase NoInfo Name
e TypeM
  (TypeExp (ExpBase NoInfo VName) VName
   -> SrcLoc -> ExpBase NoInfo VName)
-> TypeM (TypeExp (ExpBase NoInfo VName) VName)
-> TypeM (SrcLoc -> ExpBase NoInfo VName)
forall a b. TypeM (a -> b) -> TypeM a -> TypeM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TypeExp (ExpBase NoInfo Name) Name
-> TypeM (TypeExp (ExpBase NoInfo VName) VName)
resolveTypeExp TypeExp (ExpBase NoInfo Name) Name
te TypeM (SrcLoc -> ExpBase NoInfo VName)
-> TypeM SrcLoc -> TypeM (ExpBase NoInfo VName)
forall a b. TypeM (a -> b) -> TypeM a -> TypeM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SrcLoc -> TypeM SrcLoc
forall a. a -> TypeM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
loc
resolveExp (Coerce ExpBase NoInfo Name
e TypeExp (ExpBase NoInfo Name) Name
te NoInfo StructType
info SrcLoc
loc) =
  ExpBase NoInfo VName
-> TypeExp (ExpBase NoInfo VName) VName
-> NoInfo StructType
-> SrcLoc
-> ExpBase NoInfo VName
forall (f :: * -> *) vn.
ExpBase f vn
-> TypeExp (ExpBase f vn) vn
-> f StructType
-> SrcLoc
-> ExpBase f vn
Coerce (ExpBase NoInfo VName
 -> TypeExp (ExpBase NoInfo VName) VName
 -> NoInfo StructType
 -> SrcLoc
 -> ExpBase NoInfo VName)
-> TypeM (ExpBase NoInfo VName)
-> TypeM
     (TypeExp (ExpBase NoInfo VName) VName
      -> NoInfo StructType -> SrcLoc -> ExpBase NoInfo VName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ExpBase NoInfo Name -> TypeM (ExpBase NoInfo VName)
resolveExp ExpBase NoInfo Name
e TypeM
  (TypeExp (ExpBase NoInfo VName) VName
   -> NoInfo StructType -> SrcLoc -> ExpBase NoInfo VName)
-> TypeM (TypeExp (ExpBase NoInfo VName) VName)
-> TypeM (NoInfo StructType -> SrcLoc -> ExpBase NoInfo VName)
forall a b. TypeM (a -> b) -> TypeM a -> TypeM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TypeExp (ExpBase NoInfo Name) Name
-> TypeM (TypeExp (ExpBase NoInfo VName) VName)
resolveTypeExp TypeExp (ExpBase NoInfo Name) Name
te TypeM (NoInfo StructType -> SrcLoc -> ExpBase NoInfo VName)
-> TypeM (NoInfo StructType)
-> TypeM (SrcLoc -> ExpBase NoInfo VName)
forall a b. TypeM (a -> b) -> TypeM a -> TypeM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> NoInfo StructType -> TypeM (NoInfo StructType)
forall a. a -> TypeM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure NoInfo StructType
info TypeM (SrcLoc -> ExpBase NoInfo VName)
-> TypeM SrcLoc -> TypeM (ExpBase NoInfo VName)
forall a b. TypeM (a -> b) -> TypeM a -> TypeM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SrcLoc -> TypeM SrcLoc
forall a. a -> TypeM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
loc
resolveExp (AppExp AppExpBase NoInfo Name
e NoInfo AppRes
NoInfo) =
  AppExpBase NoInfo VName -> NoInfo AppRes -> ExpBase NoInfo VName
forall (f :: * -> *) vn.
AppExpBase f vn -> f AppRes -> ExpBase f vn
AppExp (AppExpBase NoInfo VName -> NoInfo AppRes -> ExpBase NoInfo VName)
-> TypeM (AppExpBase NoInfo VName)
-> TypeM (NoInfo AppRes -> ExpBase NoInfo VName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AppExpBase NoInfo Name -> TypeM (AppExpBase NoInfo VName)
resolveAppExp AppExpBase NoInfo Name
e TypeM (NoInfo AppRes -> ExpBase NoInfo VName)
-> TypeM (NoInfo AppRes) -> TypeM (ExpBase NoInfo VName)
forall a b. TypeM (a -> b) -> TypeM a -> TypeM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> NoInfo AppRes -> TypeM (NoInfo AppRes)
forall a. a -> TypeM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure NoInfo AppRes
forall {k} (a :: k). NoInfo a
NoInfo

sizeBinderToParam :: SizeBinder Name -> UncheckedTypeParam
sizeBinderToParam :: SizeBinder Name -> UncheckedTypeParam
sizeBinderToParam (SizeBinder Name
v SrcLoc
loc) = Name -> SrcLoc -> UncheckedTypeParam
forall vn. vn -> SrcLoc -> TypeParamBase vn
TypeParamDim Name
v SrcLoc
loc

resolveAppExp :: AppExpBase NoInfo Name -> TypeM (AppExpBase NoInfo VName)
resolveAppExp :: AppExpBase NoInfo Name -> TypeM (AppExpBase NoInfo VName)
resolveAppExp (Apply ExpBase NoInfo Name
f NonEmpty (NoInfo (Maybe VName), ExpBase NoInfo Name)
args SrcLoc
loc) =
  ExpBase NoInfo VName
-> NonEmpty (NoInfo (Maybe VName), ExpBase NoInfo VName)
-> SrcLoc
-> AppExpBase NoInfo VName
forall (f :: * -> *) vn.
ExpBase f vn
-> NonEmpty (f (Maybe VName), ExpBase f vn)
-> SrcLoc
-> AppExpBase f vn
Apply (ExpBase NoInfo VName
 -> NonEmpty (NoInfo (Maybe VName), ExpBase NoInfo VName)
 -> SrcLoc
 -> AppExpBase NoInfo VName)
-> TypeM (ExpBase NoInfo VName)
-> TypeM
     (NonEmpty (NoInfo (Maybe VName), ExpBase NoInfo VName)
      -> SrcLoc -> AppExpBase NoInfo VName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ExpBase NoInfo Name -> TypeM (ExpBase NoInfo VName)
resolveExp ExpBase NoInfo Name
f TypeM
  (NonEmpty (NoInfo (Maybe VName), ExpBase NoInfo VName)
   -> SrcLoc -> AppExpBase NoInfo VName)
-> TypeM (NonEmpty (NoInfo (Maybe VName), ExpBase NoInfo VName))
-> TypeM (SrcLoc -> AppExpBase NoInfo VName)
forall a b. TypeM (a -> b) -> TypeM a -> TypeM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((NoInfo (Maybe VName), ExpBase NoInfo Name)
 -> TypeM (NoInfo (Maybe VName), ExpBase NoInfo VName))
-> NonEmpty (NoInfo (Maybe VName), ExpBase NoInfo Name)
-> TypeM (NonEmpty (NoInfo (Maybe VName), ExpBase NoInfo VName))
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) -> NonEmpty a -> f (NonEmpty b)
traverse ((ExpBase NoInfo Name -> TypeM (ExpBase NoInfo VName))
-> (NoInfo (Maybe VName), ExpBase NoInfo Name)
-> TypeM (NoInfo (Maybe VName), ExpBase NoInfo VName)
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)
-> (NoInfo (Maybe VName), a) -> f (NoInfo (Maybe VName), b)
traverse ExpBase NoInfo Name -> TypeM (ExpBase NoInfo VName)
resolveExp) NonEmpty (NoInfo (Maybe VName), ExpBase NoInfo Name)
args TypeM (SrcLoc -> AppExpBase NoInfo VName)
-> TypeM SrcLoc -> TypeM (AppExpBase NoInfo VName)
forall a b. TypeM (a -> b) -> TypeM a -> TypeM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SrcLoc -> TypeM SrcLoc
forall a. a -> TypeM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
loc
resolveAppExp (Range ExpBase NoInfo Name
e1 Maybe (ExpBase NoInfo Name)
e2 Inclusiveness (ExpBase NoInfo Name)
e3 SrcLoc
loc) =
  ExpBase NoInfo VName
-> Maybe (ExpBase NoInfo VName)
-> Inclusiveness (ExpBase NoInfo VName)
-> SrcLoc
-> AppExpBase NoInfo VName
forall (f :: * -> *) vn.
ExpBase f vn
-> Maybe (ExpBase f vn)
-> Inclusiveness (ExpBase f vn)
-> SrcLoc
-> AppExpBase f vn
Range
    (ExpBase NoInfo VName
 -> Maybe (ExpBase NoInfo VName)
 -> Inclusiveness (ExpBase NoInfo VName)
 -> SrcLoc
 -> AppExpBase NoInfo VName)
-> TypeM (ExpBase NoInfo VName)
-> TypeM
     (Maybe (ExpBase NoInfo VName)
      -> Inclusiveness (ExpBase NoInfo VName)
      -> SrcLoc
      -> AppExpBase NoInfo VName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ExpBase NoInfo Name -> TypeM (ExpBase NoInfo VName)
resolveExp ExpBase NoInfo Name
e1
    TypeM
  (Maybe (ExpBase NoInfo VName)
   -> Inclusiveness (ExpBase NoInfo VName)
   -> SrcLoc
   -> AppExpBase NoInfo VName)
-> TypeM (Maybe (ExpBase NoInfo VName))
-> TypeM
     (Inclusiveness (ExpBase NoInfo VName)
      -> SrcLoc -> AppExpBase NoInfo VName)
forall a b. TypeM (a -> b) -> TypeM a -> TypeM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (ExpBase NoInfo Name -> TypeM (ExpBase NoInfo VName))
-> Maybe (ExpBase NoInfo Name)
-> TypeM (Maybe (ExpBase NoInfo VName))
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) -> Maybe a -> f (Maybe b)
traverse ExpBase NoInfo Name -> TypeM (ExpBase NoInfo VName)
resolveExp Maybe (ExpBase NoInfo Name)
e2
    TypeM
  (Inclusiveness (ExpBase NoInfo VName)
   -> SrcLoc -> AppExpBase NoInfo VName)
-> TypeM (Inclusiveness (ExpBase NoInfo VName))
-> TypeM (SrcLoc -> AppExpBase NoInfo VName)
forall a b. TypeM (a -> b) -> TypeM a -> TypeM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (ExpBase NoInfo Name -> TypeM (ExpBase NoInfo VName))
-> Inclusiveness (ExpBase NoInfo Name)
-> TypeM (Inclusiveness (ExpBase NoInfo VName))
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) -> Inclusiveness a -> f (Inclusiveness b)
traverse ExpBase NoInfo Name -> TypeM (ExpBase NoInfo VName)
resolveExp Inclusiveness (ExpBase NoInfo Name)
e3
    TypeM (SrcLoc -> AppExpBase NoInfo VName)
-> TypeM SrcLoc -> TypeM (AppExpBase NoInfo VName)
forall a b. TypeM (a -> b) -> TypeM a -> TypeM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SrcLoc -> TypeM SrcLoc
forall a. a -> TypeM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
loc
resolveAppExp (If ExpBase NoInfo Name
e1 ExpBase NoInfo Name
e2 ExpBase NoInfo Name
e3 SrcLoc
loc) =
  ExpBase NoInfo VName
-> ExpBase NoInfo VName
-> ExpBase NoInfo VName
-> SrcLoc
-> AppExpBase NoInfo VName
forall (f :: * -> *) vn.
ExpBase f vn
-> ExpBase f vn -> ExpBase f vn -> SrcLoc -> AppExpBase f vn
If (ExpBase NoInfo VName
 -> ExpBase NoInfo VName
 -> ExpBase NoInfo VName
 -> SrcLoc
 -> AppExpBase NoInfo VName)
-> TypeM (ExpBase NoInfo VName)
-> TypeM
     (ExpBase NoInfo VName
      -> ExpBase NoInfo VName -> SrcLoc -> AppExpBase NoInfo VName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ExpBase NoInfo Name -> TypeM (ExpBase NoInfo VName)
resolveExp ExpBase NoInfo Name
e1 TypeM
  (ExpBase NoInfo VName
   -> ExpBase NoInfo VName -> SrcLoc -> AppExpBase NoInfo VName)
-> TypeM (ExpBase NoInfo VName)
-> TypeM
     (ExpBase NoInfo VName -> SrcLoc -> AppExpBase NoInfo VName)
forall a b. TypeM (a -> b) -> TypeM a -> TypeM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ExpBase NoInfo Name -> TypeM (ExpBase NoInfo VName)
resolveExp ExpBase NoInfo Name
e2 TypeM (ExpBase NoInfo VName -> SrcLoc -> AppExpBase NoInfo VName)
-> TypeM (ExpBase NoInfo VName)
-> TypeM (SrcLoc -> AppExpBase NoInfo VName)
forall a b. TypeM (a -> b) -> TypeM a -> TypeM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ExpBase NoInfo Name -> TypeM (ExpBase NoInfo VName)
resolveExp ExpBase NoInfo Name
e3 TypeM (SrcLoc -> AppExpBase NoInfo VName)
-> TypeM SrcLoc -> TypeM (AppExpBase NoInfo VName)
forall a b. TypeM (a -> b) -> TypeM a -> TypeM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SrcLoc -> TypeM SrcLoc
forall a. a -> TypeM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
loc
resolveAppExp (Match ExpBase NoInfo Name
e NonEmpty (CaseBase NoInfo Name)
cases SrcLoc
loc) =
  ExpBase NoInfo VName
-> NonEmpty (CaseBase NoInfo VName)
-> SrcLoc
-> AppExpBase NoInfo VName
forall (f :: * -> *) vn.
ExpBase f vn
-> NonEmpty (CaseBase f vn) -> SrcLoc -> AppExpBase f vn
Match (ExpBase NoInfo VName
 -> NonEmpty (CaseBase NoInfo VName)
 -> SrcLoc
 -> AppExpBase NoInfo VName)
-> TypeM (ExpBase NoInfo VName)
-> TypeM
     (NonEmpty (CaseBase NoInfo VName)
      -> SrcLoc -> AppExpBase NoInfo VName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ExpBase NoInfo Name -> TypeM (ExpBase NoInfo VName)
resolveExp ExpBase NoInfo Name
e TypeM
  (NonEmpty (CaseBase NoInfo VName)
   -> SrcLoc -> AppExpBase NoInfo VName)
-> TypeM (NonEmpty (CaseBase NoInfo VName))
-> TypeM (SrcLoc -> AppExpBase NoInfo VName)
forall a b. TypeM (a -> b) -> TypeM a -> TypeM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (CaseBase NoInfo Name -> TypeM (CaseBase NoInfo VName))
-> NonEmpty (CaseBase NoInfo Name)
-> TypeM (NonEmpty (CaseBase NoInfo VName))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> NonEmpty a -> m (NonEmpty b)
mapM CaseBase NoInfo Name -> TypeM (CaseBase NoInfo VName)
resolveCase NonEmpty (CaseBase NoInfo Name)
cases TypeM (SrcLoc -> AppExpBase NoInfo VName)
-> TypeM SrcLoc -> TypeM (AppExpBase NoInfo VName)
forall a b. TypeM (a -> b) -> TypeM a -> TypeM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SrcLoc -> TypeM SrcLoc
forall a. a -> TypeM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
loc
  where
    resolveCase :: CaseBase NoInfo Name -> TypeM (CaseBase NoInfo VName)
resolveCase (CasePat PatBase NoInfo Name StructType
p ExpBase NoInfo Name
body SrcLoc
cloc) =
      PatBase NoInfo Name StructType
-> (PatBase NoInfo VName StructType
    -> TypeM (CaseBase NoInfo VName))
-> TypeM (CaseBase NoInfo VName)
forall t a.
PatBase NoInfo Name t
-> (PatBase NoInfo VName t -> TypeM a) -> TypeM a
resolvePat PatBase NoInfo Name StructType
p ((PatBase NoInfo VName StructType -> TypeM (CaseBase NoInfo VName))
 -> TypeM (CaseBase NoInfo VName))
-> (PatBase NoInfo VName StructType
    -> TypeM (CaseBase NoInfo VName))
-> TypeM (CaseBase NoInfo VName)
forall a b. (a -> b) -> a -> b
$ \PatBase NoInfo VName StructType
p' -> PatBase NoInfo VName StructType
-> ExpBase NoInfo VName -> SrcLoc -> CaseBase NoInfo VName
forall (f :: * -> *) vn.
PatBase f vn StructType -> ExpBase f vn -> SrcLoc -> CaseBase f vn
CasePat PatBase NoInfo VName StructType
p' (ExpBase NoInfo VName -> SrcLoc -> CaseBase NoInfo VName)
-> TypeM (ExpBase NoInfo VName)
-> TypeM (SrcLoc -> CaseBase NoInfo VName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ExpBase NoInfo Name -> TypeM (ExpBase NoInfo VName)
resolveExp ExpBase NoInfo Name
body TypeM (SrcLoc -> CaseBase NoInfo VName)
-> TypeM SrcLoc -> TypeM (CaseBase NoInfo VName)
forall a b. TypeM (a -> b) -> TypeM a -> TypeM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SrcLoc -> TypeM SrcLoc
forall a. a -> TypeM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
cloc
resolveAppExp (LetPat [SizeBinder Name]
sizes PatBase NoInfo Name StructType
p ExpBase NoInfo Name
e1 ExpBase NoInfo Name
e2 SrcLoc
loc) = do
  [UncheckedTypeParam]
-> [PatBase NoInfo Name StructType] -> TypeM ()
forall (m :: * -> *) t.
MonadTypeChecker m =>
[UncheckedTypeParam] -> [UncheckedPat t] -> m ()
checkForDuplicateNames ((SizeBinder Name -> UncheckedTypeParam)
-> [SizeBinder Name] -> [UncheckedTypeParam]
forall a b. (a -> b) -> [a] -> [b]
map SizeBinder Name -> UncheckedTypeParam
sizeBinderToParam [SizeBinder Name]
sizes) [PatBase NoInfo Name StructType
p]
  [SizeBinder Name]
-> ([SizeBinder VName] -> TypeM (AppExpBase NoInfo VName))
-> TypeM (AppExpBase NoInfo VName)
forall a.
[SizeBinder Name] -> ([SizeBinder VName] -> TypeM a) -> TypeM a
resolveSizes [SizeBinder Name]
sizes (([SizeBinder VName] -> TypeM (AppExpBase NoInfo VName))
 -> TypeM (AppExpBase NoInfo VName))
-> ([SizeBinder VName] -> TypeM (AppExpBase NoInfo VName))
-> TypeM (AppExpBase NoInfo VName)
forall a b. (a -> b) -> a -> b
$ \[SizeBinder VName]
sizes' -> do
    ExpBase NoInfo VName
e1' <- ExpBase NoInfo Name -> TypeM (ExpBase NoInfo VName)
resolveExp ExpBase NoInfo Name
e1
    PatBase NoInfo Name StructType
-> (PatBase NoInfo VName StructType
    -> TypeM (AppExpBase NoInfo VName))
-> TypeM (AppExpBase NoInfo VName)
forall t a.
PatBase NoInfo Name t
-> (PatBase NoInfo VName t -> TypeM a) -> TypeM a
resolvePat PatBase NoInfo Name StructType
p ((PatBase NoInfo VName StructType
  -> TypeM (AppExpBase NoInfo VName))
 -> TypeM (AppExpBase NoInfo VName))
-> (PatBase NoInfo VName StructType
    -> TypeM (AppExpBase NoInfo VName))
-> TypeM (AppExpBase NoInfo VName)
forall a b. (a -> b) -> a -> b
$ \PatBase NoInfo VName StructType
p' -> do
      ExpBase NoInfo VName
e2' <- ExpBase NoInfo Name -> TypeM (ExpBase NoInfo VName)
resolveExp ExpBase NoInfo Name
e2
      AppExpBase NoInfo VName -> TypeM (AppExpBase NoInfo VName)
forall a. a -> TypeM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AppExpBase NoInfo VName -> TypeM (AppExpBase NoInfo VName))
-> AppExpBase NoInfo VName -> TypeM (AppExpBase NoInfo VName)
forall a b. (a -> b) -> a -> b
$ [SizeBinder VName]
-> PatBase NoInfo VName StructType
-> ExpBase NoInfo VName
-> ExpBase NoInfo VName
-> SrcLoc
-> AppExpBase NoInfo VName
forall (f :: * -> *) vn.
[SizeBinder vn]
-> PatBase f vn StructType
-> ExpBase f vn
-> ExpBase f vn
-> SrcLoc
-> AppExpBase f vn
LetPat [SizeBinder VName]
sizes' PatBase NoInfo VName StructType
p' ExpBase NoInfo VName
e1' ExpBase NoInfo VName
e2' SrcLoc
loc
resolveAppExp (LetFun Name
fname ([UncheckedTypeParam]
tparams, [PatBase NoInfo Name ParamType]
params, Maybe (TypeExp (ExpBase NoInfo Name) Name)
ret, NoInfo ResRetType
NoInfo, ExpBase NoInfo Name
fbody) ExpBase NoInfo Name
body SrcLoc
loc) = do
  [UncheckedTypeParam] -> [PatBase NoInfo Name ParamType] -> TypeM ()
forall (m :: * -> *) t.
MonadTypeChecker m =>
[UncheckedTypeParam] -> [UncheckedPat t] -> m ()
checkForDuplicateNames [UncheckedTypeParam]
tparams [PatBase NoInfo Name ParamType]
params
  SrcLoc -> Name -> TypeM ()
forall a. Located a => a -> Name -> TypeM ()
checkDoNotShadow SrcLoc
loc Name
fname
  ([TypeParamBase VName]
tparams', [PatBase NoInfo VName ParamType]
params', Maybe (TypeExp (ExpBase NoInfo VName) VName)
ret', ExpBase NoInfo VName
fbody') <-
    [UncheckedTypeParam]
-> ([TypeParamBase VName]
    -> TypeM
         ([TypeParamBase VName], [PatBase NoInfo VName ParamType],
          Maybe (TypeExp (ExpBase NoInfo VName) VName),
          ExpBase NoInfo VName))
-> TypeM
     ([TypeParamBase VName], [PatBase NoInfo VName ParamType],
      Maybe (TypeExp (ExpBase NoInfo VName) VName), ExpBase NoInfo VName)
forall a.
[UncheckedTypeParam]
-> ([TypeParamBase VName] -> TypeM a) -> TypeM a
resolveTypeParams [UncheckedTypeParam]
tparams (([TypeParamBase VName]
  -> TypeM
       ([TypeParamBase VName], [PatBase NoInfo VName ParamType],
        Maybe (TypeExp (ExpBase NoInfo VName) VName),
        ExpBase NoInfo VName))
 -> TypeM
      ([TypeParamBase VName], [PatBase NoInfo VName ParamType],
       Maybe (TypeExp (ExpBase NoInfo VName) VName),
       ExpBase NoInfo VName))
-> ([TypeParamBase VName]
    -> TypeM
         ([TypeParamBase VName], [PatBase NoInfo VName ParamType],
          Maybe (TypeExp (ExpBase NoInfo VName) VName),
          ExpBase NoInfo VName))
-> TypeM
     ([TypeParamBase VName], [PatBase NoInfo VName ParamType],
      Maybe (TypeExp (ExpBase NoInfo VName) VName), ExpBase NoInfo VName)
forall a b. (a -> b) -> a -> b
$ \[TypeParamBase VName]
tparams' ->
      [PatBase NoInfo Name ParamType]
-> ([PatBase NoInfo VName ParamType]
    -> TypeM
         ([TypeParamBase VName], [PatBase NoInfo VName ParamType],
          Maybe (TypeExp (ExpBase NoInfo VName) VName),
          ExpBase NoInfo VName))
-> TypeM
     ([TypeParamBase VName], [PatBase NoInfo VName ParamType],
      Maybe (TypeExp (ExpBase NoInfo VName) VName), ExpBase NoInfo VName)
forall a.
[PatBase NoInfo Name ParamType]
-> ([PatBase NoInfo VName ParamType] -> TypeM a) -> TypeM a
resolveParams [PatBase NoInfo Name ParamType]
params (([PatBase NoInfo VName ParamType]
  -> TypeM
       ([TypeParamBase VName], [PatBase NoInfo VName ParamType],
        Maybe (TypeExp (ExpBase NoInfo VName) VName),
        ExpBase NoInfo VName))
 -> TypeM
      ([TypeParamBase VName], [PatBase NoInfo VName ParamType],
       Maybe (TypeExp (ExpBase NoInfo VName) VName),
       ExpBase NoInfo VName))
-> ([PatBase NoInfo VName ParamType]
    -> TypeM
         ([TypeParamBase VName], [PatBase NoInfo VName ParamType],
          Maybe (TypeExp (ExpBase NoInfo VName) VName),
          ExpBase NoInfo VName))
-> TypeM
     ([TypeParamBase VName], [PatBase NoInfo VName ParamType],
      Maybe (TypeExp (ExpBase NoInfo VName) VName), ExpBase NoInfo VName)
forall a b. (a -> b) -> a -> b
$ \[PatBase NoInfo VName ParamType]
params' -> do
        Maybe (TypeExp (ExpBase NoInfo VName) VName)
ret' <- (TypeExp (ExpBase NoInfo Name) Name
 -> TypeM (TypeExp (ExpBase NoInfo VName) VName))
-> Maybe (TypeExp (ExpBase NoInfo Name) Name)
-> TypeM (Maybe (TypeExp (ExpBase NoInfo VName) VName))
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) -> Maybe a -> f (Maybe b)
traverse TypeExp (ExpBase NoInfo Name) Name
-> TypeM (TypeExp (ExpBase NoInfo VName) VName)
resolveTypeExp Maybe (TypeExp (ExpBase NoInfo Name) Name)
ret
        ([TypeParamBase VName]
tparams',[PatBase NoInfo VName ParamType]
params',Maybe (TypeExp (ExpBase NoInfo VName) VName)
ret',) (ExpBase NoInfo VName
 -> ([TypeParamBase VName], [PatBase NoInfo VName ParamType],
     Maybe (TypeExp (ExpBase NoInfo VName) VName),
     ExpBase NoInfo VName))
-> TypeM (ExpBase NoInfo VName)
-> TypeM
     ([TypeParamBase VName], [PatBase NoInfo VName ParamType],
      Maybe (TypeExp (ExpBase NoInfo VName) VName), ExpBase NoInfo VName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ExpBase NoInfo Name -> TypeM (ExpBase NoInfo VName)
resolveExp ExpBase NoInfo Name
fbody
  Namespace
-> Name
-> SrcLoc
-> (VName -> TypeM (AppExpBase NoInfo VName))
-> TypeM (AppExpBase NoInfo VName)
forall a.
Namespace -> Name -> SrcLoc -> (VName -> TypeM a) -> TypeM a
bindSpaced1 Namespace
Term Name
fname SrcLoc
loc ((VName -> TypeM (AppExpBase NoInfo VName))
 -> TypeM (AppExpBase NoInfo VName))
-> (VName -> TypeM (AppExpBase NoInfo VName))
-> TypeM (AppExpBase NoInfo VName)
forall a b. (a -> b) -> a -> b
$ \VName
fname' -> do
    ExpBase NoInfo VName
body' <- ExpBase NoInfo Name -> TypeM (ExpBase NoInfo VName)
resolveExp ExpBase NoInfo Name
body
    AppExpBase NoInfo VName -> TypeM (AppExpBase NoInfo VName)
forall a. a -> TypeM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AppExpBase NoInfo VName -> TypeM (AppExpBase NoInfo VName))
-> AppExpBase NoInfo VName -> TypeM (AppExpBase NoInfo VName)
forall a b. (a -> b) -> a -> b
$ VName
-> ([TypeParamBase VName], [PatBase NoInfo VName ParamType],
    Maybe (TypeExp (ExpBase NoInfo VName) VName), NoInfo ResRetType,
    ExpBase NoInfo VName)
-> ExpBase NoInfo VName
-> SrcLoc
-> AppExpBase NoInfo VName
forall (f :: * -> *) vn.
vn
-> ([TypeParamBase vn], [PatBase f vn ParamType],
    Maybe (TypeExp (ExpBase f vn) vn), f ResRetType, ExpBase f vn)
-> ExpBase f vn
-> SrcLoc
-> AppExpBase f vn
LetFun VName
fname' ([TypeParamBase VName]
tparams', [PatBase NoInfo VName ParamType]
params', Maybe (TypeExp (ExpBase NoInfo VName) VName)
ret', NoInfo ResRetType
forall {k} (a :: k). NoInfo a
NoInfo, ExpBase NoInfo VName
fbody') ExpBase NoInfo VName
body' SrcLoc
loc
resolveAppExp (LetWith (Ident Name
dst NoInfo StructType
_ SrcLoc
dstloc) (Ident Name
src NoInfo StructType
_ SrcLoc
srcloc) SliceBase NoInfo Name
slice ExpBase NoInfo Name
e1 ExpBase NoInfo Name
e2 SrcLoc
loc) = do
  IdentBase NoInfo VName StructType
src' <- VName
-> NoInfo StructType -> SrcLoc -> IdentBase NoInfo VName StructType
forall {k} (f :: k -> *) vn (t :: k).
vn -> f t -> SrcLoc -> IdentBase f vn t
Ident (VName
 -> NoInfo StructType
 -> SrcLoc
 -> IdentBase NoInfo VName StructType)
-> TypeM VName
-> TypeM
     (NoInfo StructType -> SrcLoc -> IdentBase NoInfo VName StructType)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Name -> SrcLoc -> TypeM VName
resolveName Name
src SrcLoc
srcloc TypeM
  (NoInfo StructType -> SrcLoc -> IdentBase NoInfo VName StructType)
-> TypeM (NoInfo StructType)
-> TypeM (SrcLoc -> IdentBase NoInfo VName StructType)
forall a b. TypeM (a -> b) -> TypeM a -> TypeM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> NoInfo StructType -> TypeM (NoInfo StructType)
forall a. a -> TypeM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure NoInfo StructType
forall {k} (a :: k). NoInfo a
NoInfo TypeM (SrcLoc -> IdentBase NoInfo VName StructType)
-> TypeM SrcLoc -> TypeM (IdentBase NoInfo VName StructType)
forall a b. TypeM (a -> b) -> TypeM a -> TypeM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SrcLoc -> TypeM SrcLoc
forall a. a -> TypeM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
srcloc
  ExpBase NoInfo VName
e1' <- ExpBase NoInfo Name -> TypeM (ExpBase NoInfo VName)
resolveExp ExpBase NoInfo Name
e1
  SliceBase NoInfo VName
slice' <- SliceBase NoInfo Name -> TypeM (SliceBase NoInfo VName)
resolveSlice SliceBase NoInfo Name
slice
  Namespace
-> Name
-> SrcLoc
-> (VName -> TypeM (AppExpBase NoInfo VName))
-> TypeM (AppExpBase NoInfo VName)
forall a.
Namespace -> Name -> SrcLoc -> (VName -> TypeM a) -> TypeM a
bindSpaced1 Namespace
Term Name
dst SrcLoc
loc ((VName -> TypeM (AppExpBase NoInfo VName))
 -> TypeM (AppExpBase NoInfo VName))
-> (VName -> TypeM (AppExpBase NoInfo VName))
-> TypeM (AppExpBase NoInfo VName)
forall a b. (a -> b) -> a -> b
$ \VName
dstv -> do
    let dst' :: IdentBase NoInfo VName t
dst' = VName -> NoInfo t -> SrcLoc -> IdentBase NoInfo VName t
forall {k} (f :: k -> *) vn (t :: k).
vn -> f t -> SrcLoc -> IdentBase f vn t
Ident VName
dstv NoInfo t
forall {k} (a :: k). NoInfo a
NoInfo SrcLoc
dstloc
    ExpBase NoInfo VName
e2' <- ExpBase NoInfo Name -> TypeM (ExpBase NoInfo VName)
resolveExp ExpBase NoInfo Name
e2
    AppExpBase NoInfo VName -> TypeM (AppExpBase NoInfo VName)
forall a. a -> TypeM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AppExpBase NoInfo VName -> TypeM (AppExpBase NoInfo VName))
-> AppExpBase NoInfo VName -> TypeM (AppExpBase NoInfo VName)
forall a b. (a -> b) -> a -> b
$ IdentBase NoInfo VName StructType
-> IdentBase NoInfo VName StructType
-> SliceBase NoInfo VName
-> ExpBase NoInfo VName
-> ExpBase NoInfo VName
-> SrcLoc
-> AppExpBase NoInfo VName
forall (f :: * -> *) vn.
IdentBase f vn StructType
-> IdentBase f vn StructType
-> SliceBase f vn
-> ExpBase f vn
-> ExpBase f vn
-> SrcLoc
-> AppExpBase f vn
LetWith IdentBase NoInfo VName StructType
forall {k} {t :: k}. IdentBase NoInfo VName t
dst' IdentBase NoInfo VName StructType
src' SliceBase NoInfo VName
slice' ExpBase NoInfo VName
e1' ExpBase NoInfo VName
e2' SrcLoc
loc
resolveAppExp (BinOp (QualName Name
f, SrcLoc
floc) NoInfo StructType
finfo (ExpBase NoInfo Name
e1, NoInfo (Maybe VName)
info1) (ExpBase NoInfo Name
e2, NoInfo (Maybe VName)
info2) SrcLoc
loc) = do
  QualName VName
f' <- QualName Name -> SrcLoc -> TypeM (QualName VName)
resolveQualName QualName Name
f SrcLoc
floc
  ExpBase NoInfo VName
e1' <- ExpBase NoInfo Name -> TypeM (ExpBase NoInfo VName)
resolveExp ExpBase NoInfo Name
e1
  ExpBase NoInfo VName
e2' <- ExpBase NoInfo Name -> TypeM (ExpBase NoInfo VName)
resolveExp ExpBase NoInfo Name
e2
  AppExpBase NoInfo VName -> TypeM (AppExpBase NoInfo VName)
forall a. a -> TypeM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AppExpBase NoInfo VName -> TypeM (AppExpBase NoInfo VName))
-> AppExpBase NoInfo VName -> TypeM (AppExpBase NoInfo VName)
forall a b. (a -> b) -> a -> b
$ (QualName VName, SrcLoc)
-> NoInfo StructType
-> (ExpBase NoInfo VName, NoInfo (Maybe VName))
-> (ExpBase NoInfo VName, NoInfo (Maybe VName))
-> SrcLoc
-> AppExpBase NoInfo VName
forall (f :: * -> *) vn.
(QualName vn, SrcLoc)
-> f StructType
-> (ExpBase f vn, f (Maybe VName))
-> (ExpBase f vn, f (Maybe VName))
-> SrcLoc
-> AppExpBase f vn
BinOp (QualName VName
f', SrcLoc
floc) NoInfo StructType
finfo (ExpBase NoInfo VName
e1', NoInfo (Maybe VName)
info1) (ExpBase NoInfo VName
e2', NoInfo (Maybe VName)
info2) SrcLoc
loc
resolveAppExp (Index ExpBase NoInfo Name
e1 SliceBase NoInfo Name
slice SrcLoc
loc) =
  ExpBase NoInfo VName
-> SliceBase NoInfo VName -> SrcLoc -> AppExpBase NoInfo VName
forall (f :: * -> *) vn.
ExpBase f vn -> SliceBase f vn -> SrcLoc -> AppExpBase f vn
Index (ExpBase NoInfo VName
 -> SliceBase NoInfo VName -> SrcLoc -> AppExpBase NoInfo VName)
-> TypeM (ExpBase NoInfo VName)
-> TypeM
     (SliceBase NoInfo VName -> SrcLoc -> AppExpBase NoInfo VName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ExpBase NoInfo Name -> TypeM (ExpBase NoInfo VName)
resolveExp ExpBase NoInfo Name
e1 TypeM (SliceBase NoInfo VName -> SrcLoc -> AppExpBase NoInfo VName)
-> TypeM (SliceBase NoInfo VName)
-> TypeM (SrcLoc -> AppExpBase NoInfo VName)
forall a b. TypeM (a -> b) -> TypeM a -> TypeM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SliceBase NoInfo Name -> TypeM (SliceBase NoInfo VName)
resolveSlice SliceBase NoInfo Name
slice TypeM (SrcLoc -> AppExpBase NoInfo VName)
-> TypeM SrcLoc -> TypeM (AppExpBase NoInfo VName)
forall a b. TypeM (a -> b) -> TypeM a -> TypeM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SrcLoc -> TypeM SrcLoc
forall a. a -> TypeM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
loc
resolveAppExp (Loop [VName]
sizes PatBase NoInfo Name ParamType
pat ExpBase NoInfo Name
e LoopFormBase NoInfo Name
form ExpBase NoInfo Name
body SrcLoc
loc) = do
  ExpBase NoInfo VName
e' <- ExpBase NoInfo Name -> TypeM (ExpBase NoInfo VName)
resolveExp ExpBase NoInfo Name
e
  case LoopFormBase NoInfo Name
form of
    For (Ident Name
i NoInfo StructType
_ SrcLoc
iloc) ExpBase NoInfo Name
bound -> do
      ExpBase NoInfo VName
bound' <- ExpBase NoInfo Name -> TypeM (ExpBase NoInfo VName)
resolveExp ExpBase NoInfo Name
bound
      Namespace
-> Name
-> SrcLoc
-> (VName -> TypeM (AppExpBase NoInfo VName))
-> TypeM (AppExpBase NoInfo VName)
forall a.
Namespace -> Name -> SrcLoc -> (VName -> TypeM a) -> TypeM a
bindSpaced1 Namespace
Term Name
i SrcLoc
iloc ((VName -> TypeM (AppExpBase NoInfo VName))
 -> TypeM (AppExpBase NoInfo VName))
-> (VName -> TypeM (AppExpBase NoInfo VName))
-> TypeM (AppExpBase NoInfo VName)
forall a b. (a -> b) -> a -> b
$ \VName
iv -> do
        let i' :: IdentBase NoInfo VName t
i' = VName -> NoInfo t -> SrcLoc -> IdentBase NoInfo VName t
forall {k} (f :: k -> *) vn (t :: k).
vn -> f t -> SrcLoc -> IdentBase f vn t
Ident VName
iv NoInfo t
forall {k} (a :: k). NoInfo a
NoInfo SrcLoc
iloc
        PatBase NoInfo Name ParamType
-> (PatBase NoInfo VName ParamType
    -> TypeM (AppExpBase NoInfo VName))
-> TypeM (AppExpBase NoInfo VName)
forall t a.
PatBase NoInfo Name t
-> (PatBase NoInfo VName t -> TypeM a) -> TypeM a
resolvePat PatBase NoInfo Name ParamType
pat ((PatBase NoInfo VName ParamType
  -> TypeM (AppExpBase NoInfo VName))
 -> TypeM (AppExpBase NoInfo VName))
-> (PatBase NoInfo VName ParamType
    -> TypeM (AppExpBase NoInfo VName))
-> TypeM (AppExpBase NoInfo VName)
forall a b. (a -> b) -> a -> b
$ \PatBase NoInfo VName ParamType
pat' -> do
          ExpBase NoInfo VName
body' <- ExpBase NoInfo Name -> TypeM (ExpBase NoInfo VName)
resolveExp ExpBase NoInfo Name
body
          AppExpBase NoInfo VName -> TypeM (AppExpBase NoInfo VName)
forall a. a -> TypeM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AppExpBase NoInfo VName -> TypeM (AppExpBase NoInfo VName))
-> AppExpBase NoInfo VName -> TypeM (AppExpBase NoInfo VName)
forall a b. (a -> b) -> a -> b
$ [VName]
-> PatBase NoInfo VName ParamType
-> ExpBase NoInfo VName
-> LoopFormBase NoInfo VName
-> ExpBase NoInfo VName
-> SrcLoc
-> AppExpBase NoInfo VName
forall (f :: * -> *) vn.
[VName]
-> PatBase f vn ParamType
-> ExpBase f vn
-> LoopFormBase f vn
-> ExpBase f vn
-> SrcLoc
-> AppExpBase f vn
Loop [VName]
sizes PatBase NoInfo VName ParamType
pat' ExpBase NoInfo VName
e' (IdentBase NoInfo VName StructType
-> ExpBase NoInfo VName -> LoopFormBase NoInfo VName
forall (f :: * -> *) vn.
IdentBase f vn StructType -> ExpBase f vn -> LoopFormBase f vn
For IdentBase NoInfo VName StructType
forall {k} {t :: k}. IdentBase NoInfo VName t
i' ExpBase NoInfo VName
bound') ExpBase NoInfo VName
body' SrcLoc
loc
    ForIn PatBase NoInfo Name StructType
elemp ExpBase NoInfo Name
arr -> do
      ExpBase NoInfo VName
arr' <- ExpBase NoInfo Name -> TypeM (ExpBase NoInfo VName)
resolveExp ExpBase NoInfo Name
arr
      PatBase NoInfo Name StructType
-> (PatBase NoInfo VName StructType
    -> TypeM (AppExpBase NoInfo VName))
-> TypeM (AppExpBase NoInfo VName)
forall t a.
PatBase NoInfo Name t
-> (PatBase NoInfo VName t -> TypeM a) -> TypeM a
resolvePat PatBase NoInfo Name StructType
elemp ((PatBase NoInfo VName StructType
  -> TypeM (AppExpBase NoInfo VName))
 -> TypeM (AppExpBase NoInfo VName))
-> (PatBase NoInfo VName StructType
    -> TypeM (AppExpBase NoInfo VName))
-> TypeM (AppExpBase NoInfo VName)
forall a b. (a -> b) -> a -> b
$ \PatBase NoInfo VName StructType
elemp' -> PatBase NoInfo Name ParamType
-> (PatBase NoInfo VName ParamType
    -> TypeM (AppExpBase NoInfo VName))
-> TypeM (AppExpBase NoInfo VName)
forall t a.
PatBase NoInfo Name t
-> (PatBase NoInfo VName t -> TypeM a) -> TypeM a
resolvePat PatBase NoInfo Name ParamType
pat ((PatBase NoInfo VName ParamType
  -> TypeM (AppExpBase NoInfo VName))
 -> TypeM (AppExpBase NoInfo VName))
-> (PatBase NoInfo VName ParamType
    -> TypeM (AppExpBase NoInfo VName))
-> TypeM (AppExpBase NoInfo VName)
forall a b. (a -> b) -> a -> b
$ \PatBase NoInfo VName ParamType
pat' -> do
        ExpBase NoInfo VName
body' <- ExpBase NoInfo Name -> TypeM (ExpBase NoInfo VName)
resolveExp ExpBase NoInfo Name
body
        AppExpBase NoInfo VName -> TypeM (AppExpBase NoInfo VName)
forall a. a -> TypeM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AppExpBase NoInfo VName -> TypeM (AppExpBase NoInfo VName))
-> AppExpBase NoInfo VName -> TypeM (AppExpBase NoInfo VName)
forall a b. (a -> b) -> a -> b
$ [VName]
-> PatBase NoInfo VName ParamType
-> ExpBase NoInfo VName
-> LoopFormBase NoInfo VName
-> ExpBase NoInfo VName
-> SrcLoc
-> AppExpBase NoInfo VName
forall (f :: * -> *) vn.
[VName]
-> PatBase f vn ParamType
-> ExpBase f vn
-> LoopFormBase f vn
-> ExpBase f vn
-> SrcLoc
-> AppExpBase f vn
Loop [VName]
sizes PatBase NoInfo VName ParamType
pat' ExpBase NoInfo VName
e' (PatBase NoInfo VName StructType
-> ExpBase NoInfo VName -> LoopFormBase NoInfo VName
forall (f :: * -> *) vn.
PatBase f vn StructType -> ExpBase f vn -> LoopFormBase f vn
ForIn PatBase NoInfo VName StructType
elemp' ExpBase NoInfo VName
arr') ExpBase NoInfo VName
body' SrcLoc
loc
    While ExpBase NoInfo Name
cond -> PatBase NoInfo Name ParamType
-> (PatBase NoInfo VName ParamType
    -> TypeM (AppExpBase NoInfo VName))
-> TypeM (AppExpBase NoInfo VName)
forall t a.
PatBase NoInfo Name t
-> (PatBase NoInfo VName t -> TypeM a) -> TypeM a
resolvePat PatBase NoInfo Name ParamType
pat ((PatBase NoInfo VName ParamType
  -> TypeM (AppExpBase NoInfo VName))
 -> TypeM (AppExpBase NoInfo VName))
-> (PatBase NoInfo VName ParamType
    -> TypeM (AppExpBase NoInfo VName))
-> TypeM (AppExpBase NoInfo VName)
forall a b. (a -> b) -> a -> b
$ \PatBase NoInfo VName ParamType
pat' -> do
      ExpBase NoInfo VName
cond' <- ExpBase NoInfo Name -> TypeM (ExpBase NoInfo VName)
resolveExp ExpBase NoInfo Name
cond
      ExpBase NoInfo VName
body' <- ExpBase NoInfo Name -> TypeM (ExpBase NoInfo VName)
resolveExp ExpBase NoInfo Name
body
      AppExpBase NoInfo VName -> TypeM (AppExpBase NoInfo VName)
forall a. a -> TypeM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AppExpBase NoInfo VName -> TypeM (AppExpBase NoInfo VName))
-> AppExpBase NoInfo VName -> TypeM (AppExpBase NoInfo VName)
forall a b. (a -> b) -> a -> b
$ [VName]
-> PatBase NoInfo VName ParamType
-> ExpBase NoInfo VName
-> LoopFormBase NoInfo VName
-> ExpBase NoInfo VName
-> SrcLoc
-> AppExpBase NoInfo VName
forall (f :: * -> *) vn.
[VName]
-> PatBase f vn ParamType
-> ExpBase f vn
-> LoopFormBase f vn
-> ExpBase f vn
-> SrcLoc
-> AppExpBase f vn
Loop [VName]
sizes PatBase NoInfo VName ParamType
pat' ExpBase NoInfo VName
e' (ExpBase NoInfo VName -> LoopFormBase NoInfo VName
forall (f :: * -> *) vn. ExpBase f vn -> LoopFormBase f vn
While ExpBase NoInfo VName
cond') ExpBase NoInfo VName
body' SrcLoc
loc

resolveSlice :: SliceBase NoInfo Name -> TypeM (SliceBase NoInfo VName)
resolveSlice :: SliceBase NoInfo Name -> TypeM (SliceBase NoInfo VName)
resolveSlice = (DimIndexBase NoInfo Name -> TypeM (DimIndexBase NoInfo VName))
-> SliceBase NoInfo Name -> TypeM (SliceBase NoInfo VName)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM DimIndexBase NoInfo Name -> TypeM (DimIndexBase NoInfo VName)
onDimIndex
  where
    onDimIndex :: DimIndexBase NoInfo Name -> TypeM (DimIndexBase NoInfo VName)
onDimIndex (DimFix ExpBase NoInfo Name
e) = ExpBase NoInfo VName -> DimIndexBase NoInfo VName
forall (f :: * -> *) vn. ExpBase f vn -> DimIndexBase f vn
DimFix (ExpBase NoInfo VName -> DimIndexBase NoInfo VName)
-> TypeM (ExpBase NoInfo VName)
-> TypeM (DimIndexBase NoInfo VName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ExpBase NoInfo Name -> TypeM (ExpBase NoInfo VName)
resolveExp ExpBase NoInfo Name
e
    onDimIndex (DimSlice Maybe (ExpBase NoInfo Name)
e1 Maybe (ExpBase NoInfo Name)
e2 Maybe (ExpBase NoInfo Name)
e3) =
      Maybe (ExpBase NoInfo VName)
-> Maybe (ExpBase NoInfo VName)
-> Maybe (ExpBase NoInfo VName)
-> DimIndexBase NoInfo VName
forall (f :: * -> *) vn.
Maybe (ExpBase f vn)
-> Maybe (ExpBase f vn)
-> Maybe (ExpBase f vn)
-> DimIndexBase f vn
DimSlice
        (Maybe (ExpBase NoInfo VName)
 -> Maybe (ExpBase NoInfo VName)
 -> Maybe (ExpBase NoInfo VName)
 -> DimIndexBase NoInfo VName)
-> TypeM (Maybe (ExpBase NoInfo VName))
-> TypeM
     (Maybe (ExpBase NoInfo VName)
      -> Maybe (ExpBase NoInfo VName) -> DimIndexBase NoInfo VName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ExpBase NoInfo Name -> TypeM (ExpBase NoInfo VName))
-> Maybe (ExpBase NoInfo Name)
-> TypeM (Maybe (ExpBase NoInfo VName))
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) -> Maybe a -> f (Maybe b)
traverse ExpBase NoInfo Name -> TypeM (ExpBase NoInfo VName)
resolveExp Maybe (ExpBase NoInfo Name)
e1
        TypeM
  (Maybe (ExpBase NoInfo VName)
   -> Maybe (ExpBase NoInfo VName) -> DimIndexBase NoInfo VName)
-> TypeM (Maybe (ExpBase NoInfo VName))
-> TypeM
     (Maybe (ExpBase NoInfo VName) -> DimIndexBase NoInfo VName)
forall a b. TypeM (a -> b) -> TypeM a -> TypeM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (ExpBase NoInfo Name -> TypeM (ExpBase NoInfo VName))
-> Maybe (ExpBase NoInfo Name)
-> TypeM (Maybe (ExpBase NoInfo VName))
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) -> Maybe a -> f (Maybe b)
traverse ExpBase NoInfo Name -> TypeM (ExpBase NoInfo VName)
resolveExp Maybe (ExpBase NoInfo Name)
e2
        TypeM (Maybe (ExpBase NoInfo VName) -> DimIndexBase NoInfo VName)
-> TypeM (Maybe (ExpBase NoInfo VName))
-> TypeM (DimIndexBase NoInfo VName)
forall a b. TypeM (a -> b) -> TypeM a -> TypeM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (ExpBase NoInfo Name -> TypeM (ExpBase NoInfo VName))
-> Maybe (ExpBase NoInfo Name)
-> TypeM (Maybe (ExpBase NoInfo VName))
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) -> Maybe a -> f (Maybe b)
traverse ExpBase NoInfo Name -> TypeM (ExpBase NoInfo VName)
resolveExp Maybe (ExpBase NoInfo Name)
e3

resolvePat :: PatBase NoInfo Name t -> (PatBase NoInfo VName t -> TypeM a) -> TypeM a
resolvePat :: forall t a.
PatBase NoInfo Name t
-> (PatBase NoInfo VName t -> TypeM a) -> TypeM a
resolvePat PatBase NoInfo Name t
outer PatBase NoInfo VName t -> TypeM a
m = do
  PatBase NoInfo VName t
outer' <- PatBase NoInfo Name t -> TypeM (PatBase NoInfo VName t)
forall {t} {t}.
PatBase NoInfo Name t -> TypeM (PatBase NoInfo VName t)
resolve PatBase NoInfo Name t
outer
  [IdentBase NoInfo VName t] -> TypeM a -> TypeM a
forall {k} (t :: k) a.
[IdentBase NoInfo VName t] -> TypeM a -> TypeM a
bindIdents (PatBase NoInfo VName t -> [IdentBase NoInfo VName t]
forall (f :: * -> *) vn t. PatBase f vn t -> [IdentBase f vn t]
patIdents PatBase NoInfo VName t
outer') (TypeM a -> TypeM a) -> TypeM a -> TypeM a
forall a b. (a -> b) -> a -> b
$ PatBase NoInfo VName t -> TypeM a
m PatBase NoInfo VName t
outer'
  where
    resolve :: PatBase NoInfo Name t -> TypeM (PatBase NoInfo VName t)
resolve (Id Name
v NoInfo t
NoInfo SrcLoc
loc) = do
      SrcLoc -> Name -> TypeM ()
forall a. Located a => a -> Name -> TypeM ()
checkDoNotShadow SrcLoc
loc Name
v
      VName -> NoInfo t -> SrcLoc -> PatBase NoInfo VName t
forall (f :: * -> *) vn t. vn -> f t -> SrcLoc -> PatBase f vn t
Id (VName -> NoInfo t -> SrcLoc -> PatBase NoInfo VName t)
-> TypeM VName
-> TypeM (NoInfo t -> SrcLoc -> PatBase NoInfo VName t)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Name -> TypeM VName
forall (m :: * -> *). MonadTypeChecker m => Name -> m VName
newID Name
v TypeM (NoInfo t -> SrcLoc -> PatBase NoInfo VName t)
-> TypeM (NoInfo t) -> TypeM (SrcLoc -> PatBase NoInfo VName t)
forall a b. TypeM (a -> b) -> TypeM a -> TypeM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> NoInfo t -> TypeM (NoInfo t)
forall a. a -> TypeM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure NoInfo t
forall {k} (a :: k). NoInfo a
NoInfo TypeM (SrcLoc -> PatBase NoInfo VName t)
-> TypeM SrcLoc -> TypeM (PatBase NoInfo VName t)
forall a b. TypeM (a -> b) -> TypeM a -> TypeM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SrcLoc -> TypeM SrcLoc
forall a. a -> TypeM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
loc
    resolve (Wildcard NoInfo t
NoInfo SrcLoc
loc) =
      PatBase NoInfo VName t -> TypeM (PatBase NoInfo VName t)
forall a. a -> TypeM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PatBase NoInfo VName t -> TypeM (PatBase NoInfo VName t))
-> PatBase NoInfo VName t -> TypeM (PatBase NoInfo VName t)
forall a b. (a -> b) -> a -> b
$ NoInfo t -> SrcLoc -> PatBase NoInfo VName t
forall (f :: * -> *) vn t. f t -> SrcLoc -> PatBase f vn t
Wildcard NoInfo t
forall {k} (a :: k). NoInfo a
NoInfo SrcLoc
loc
    resolve (PatParens PatBase NoInfo Name t
p SrcLoc
loc) =
      PatBase NoInfo VName t -> SrcLoc -> PatBase NoInfo VName t
forall (f :: * -> *) vn t.
PatBase f vn t -> SrcLoc -> PatBase f vn t
PatParens (PatBase NoInfo VName t -> SrcLoc -> PatBase NoInfo VName t)
-> TypeM (PatBase NoInfo VName t)
-> TypeM (SrcLoc -> PatBase NoInfo VName t)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PatBase NoInfo Name t -> TypeM (PatBase NoInfo VName t)
resolve PatBase NoInfo Name t
p TypeM (SrcLoc -> PatBase NoInfo VName t)
-> TypeM SrcLoc -> TypeM (PatBase NoInfo VName t)
forall a b. TypeM (a -> b) -> TypeM a -> TypeM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SrcLoc -> TypeM SrcLoc
forall a. a -> TypeM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
loc
    resolve (TuplePat [PatBase NoInfo Name t]
ps SrcLoc
loc) =
      [PatBase NoInfo VName t] -> SrcLoc -> PatBase NoInfo VName t
forall (f :: * -> *) vn t.
[PatBase f vn t] -> SrcLoc -> PatBase f vn t
TuplePat ([PatBase NoInfo VName t] -> SrcLoc -> PatBase NoInfo VName t)
-> TypeM [PatBase NoInfo VName t]
-> TypeM (SrcLoc -> PatBase NoInfo VName t)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PatBase NoInfo Name t -> TypeM (PatBase NoInfo VName t))
-> [PatBase NoInfo Name t] -> TypeM [PatBase NoInfo VName t]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM PatBase NoInfo Name t -> TypeM (PatBase NoInfo VName t)
resolve [PatBase NoInfo Name t]
ps TypeM (SrcLoc -> PatBase NoInfo VName t)
-> TypeM SrcLoc -> TypeM (PatBase NoInfo VName t)
forall a b. TypeM (a -> b) -> TypeM a -> TypeM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SrcLoc -> TypeM SrcLoc
forall a. a -> TypeM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
loc
    resolve (RecordPat [(Name, PatBase NoInfo Name t)]
ps SrcLoc
loc) =
      [(Name, PatBase NoInfo VName t)]
-> SrcLoc -> PatBase NoInfo VName t
forall (f :: * -> *) vn t.
[(Name, PatBase f vn t)] -> SrcLoc -> PatBase f vn t
RecordPat ([(Name, PatBase NoInfo VName t)]
 -> SrcLoc -> PatBase NoInfo VName t)
-> TypeM [(Name, PatBase NoInfo VName t)]
-> TypeM (SrcLoc -> PatBase NoInfo VName t)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Name, PatBase NoInfo Name t)
 -> TypeM (Name, PatBase NoInfo VName t))
-> [(Name, PatBase NoInfo Name t)]
-> TypeM [(Name, PatBase NoInfo VName t)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((PatBase NoInfo Name t -> TypeM (PatBase NoInfo VName t))
-> (Name, PatBase NoInfo Name t)
-> TypeM (Name, PatBase NoInfo VName t)
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) -> (Name, a) -> f (Name, b)
traverse PatBase NoInfo Name t -> TypeM (PatBase NoInfo VName t)
resolve) [(Name, PatBase NoInfo Name t)]
ps TypeM (SrcLoc -> PatBase NoInfo VName t)
-> TypeM SrcLoc -> TypeM (PatBase NoInfo VName t)
forall a b. TypeM (a -> b) -> TypeM a -> TypeM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SrcLoc -> TypeM SrcLoc
forall a. a -> TypeM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
loc
    resolve (PatAscription PatBase NoInfo Name t
p TypeExp (ExpBase NoInfo Name) Name
t SrcLoc
loc) =
      PatBase NoInfo VName t
-> TypeExp (ExpBase NoInfo VName) VName
-> SrcLoc
-> PatBase NoInfo VName t
forall (f :: * -> *) vn t.
PatBase f vn t
-> TypeExp (ExpBase f vn) vn -> SrcLoc -> PatBase f vn t
PatAscription (PatBase NoInfo VName t
 -> TypeExp (ExpBase NoInfo VName) VName
 -> SrcLoc
 -> PatBase NoInfo VName t)
-> TypeM (PatBase NoInfo VName t)
-> TypeM
     (TypeExp (ExpBase NoInfo VName) VName
      -> SrcLoc -> PatBase NoInfo VName t)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PatBase NoInfo Name t -> TypeM (PatBase NoInfo VName t)
resolve PatBase NoInfo Name t
p TypeM
  (TypeExp (ExpBase NoInfo VName) VName
   -> SrcLoc -> PatBase NoInfo VName t)
-> TypeM (TypeExp (ExpBase NoInfo VName) VName)
-> TypeM (SrcLoc -> PatBase NoInfo VName t)
forall a b. TypeM (a -> b) -> TypeM a -> TypeM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TypeExp (ExpBase NoInfo Name) Name
-> TypeM (TypeExp (ExpBase NoInfo VName) VName)
resolveTypeExp TypeExp (ExpBase NoInfo Name) Name
t TypeM (SrcLoc -> PatBase NoInfo VName t)
-> TypeM SrcLoc -> TypeM (PatBase NoInfo VName t)
forall a b. TypeM (a -> b) -> TypeM a -> TypeM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SrcLoc -> TypeM SrcLoc
forall a. a -> TypeM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
loc
    resolve (PatLit PatLit
l NoInfo t
NoInfo SrcLoc
loc) =
      PatBase NoInfo VName t -> TypeM (PatBase NoInfo VName t)
forall a. a -> TypeM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PatBase NoInfo VName t -> TypeM (PatBase NoInfo VName t))
-> PatBase NoInfo VName t -> TypeM (PatBase NoInfo VName t)
forall a b. (a -> b) -> a -> b
$ PatLit -> NoInfo t -> SrcLoc -> PatBase NoInfo VName t
forall (f :: * -> *) vn t.
PatLit -> f t -> SrcLoc -> PatBase f vn t
PatLit PatLit
l NoInfo t
forall {k} (a :: k). NoInfo a
NoInfo SrcLoc
loc
    resolve (PatConstr Name
k NoInfo t
NoInfo [PatBase NoInfo Name t]
ps SrcLoc
loc) =
      Name
-> NoInfo t
-> [PatBase NoInfo VName t]
-> SrcLoc
-> PatBase NoInfo VName t
forall (f :: * -> *) vn t.
Name -> f t -> [PatBase f vn t] -> SrcLoc -> PatBase f vn t
PatConstr Name
k NoInfo t
forall {k} (a :: k). NoInfo a
NoInfo ([PatBase NoInfo VName t] -> SrcLoc -> PatBase NoInfo VName t)
-> TypeM [PatBase NoInfo VName t]
-> TypeM (SrcLoc -> PatBase NoInfo VName t)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PatBase NoInfo Name t -> TypeM (PatBase NoInfo VName t))
-> [PatBase NoInfo Name t] -> TypeM [PatBase NoInfo VName t]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM PatBase NoInfo Name t -> TypeM (PatBase NoInfo VName t)
resolve [PatBase NoInfo Name t]
ps TypeM (SrcLoc -> PatBase NoInfo VName t)
-> TypeM SrcLoc -> TypeM (PatBase NoInfo VName t)
forall a b. TypeM (a -> b) -> TypeM a -> TypeM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SrcLoc -> TypeM SrcLoc
forall a. a -> TypeM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
loc
    resolve (PatAttr AttrInfo Name
attr PatBase NoInfo Name t
p SrcLoc
loc) =
      AttrInfo VName
-> PatBase NoInfo VName t -> SrcLoc -> PatBase NoInfo VName t
forall (f :: * -> *) vn t.
AttrInfo vn -> PatBase f vn t -> SrcLoc -> PatBase f vn t
PatAttr (AttrInfo VName
 -> PatBase NoInfo VName t -> SrcLoc -> PatBase NoInfo VName t)
-> TypeM (AttrInfo VName)
-> TypeM
     (PatBase NoInfo VName t -> SrcLoc -> PatBase NoInfo VName t)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AttrInfo Name -> TypeM (AttrInfo VName)
resolveAttrInfo AttrInfo Name
attr TypeM (PatBase NoInfo VName t -> SrcLoc -> PatBase NoInfo VName t)
-> TypeM (PatBase NoInfo VName t)
-> TypeM (SrcLoc -> PatBase NoInfo VName t)
forall a b. TypeM (a -> b) -> TypeM a -> TypeM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> PatBase NoInfo Name t -> TypeM (PatBase NoInfo VName t)
resolve PatBase NoInfo Name t
p TypeM (SrcLoc -> PatBase NoInfo VName t)
-> TypeM SrcLoc -> TypeM (PatBase NoInfo VName t)
forall a b. TypeM (a -> b) -> TypeM a -> TypeM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SrcLoc -> TypeM SrcLoc
forall a. a -> TypeM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
loc

resolveParams :: [PatBase NoInfo Name ParamType] -> ([PatBase NoInfo VName ParamType] -> TypeM a) -> TypeM a
resolveParams :: forall a.
[PatBase NoInfo Name ParamType]
-> ([PatBase NoInfo VName ParamType] -> TypeM a) -> TypeM a
resolveParams [] [PatBase NoInfo VName ParamType] -> TypeM a
m = [PatBase NoInfo VName ParamType] -> TypeM a
m []
resolveParams (PatBase NoInfo Name ParamType
p : [PatBase NoInfo Name ParamType]
ps) [PatBase NoInfo VName ParamType] -> TypeM a
m = PatBase NoInfo Name ParamType
-> (PatBase NoInfo VName ParamType -> TypeM a) -> TypeM a
forall t a.
PatBase NoInfo Name t
-> (PatBase NoInfo VName t -> TypeM a) -> TypeM a
resolvePat PatBase NoInfo Name ParamType
p ((PatBase NoInfo VName ParamType -> TypeM a) -> TypeM a)
-> (PatBase NoInfo VName ParamType -> TypeM a) -> TypeM a
forall a b. (a -> b) -> a -> b
$ \PatBase NoInfo VName ParamType
p' -> [PatBase NoInfo Name ParamType]
-> ([PatBase NoInfo VName ParamType] -> TypeM a) -> TypeM a
forall a.
[PatBase NoInfo Name ParamType]
-> ([PatBase NoInfo VName ParamType] -> TypeM a) -> TypeM a
resolveParams [PatBase NoInfo Name ParamType]
ps ([PatBase NoInfo VName ParamType] -> TypeM a
m ([PatBase NoInfo VName ParamType] -> TypeM a)
-> ([PatBase NoInfo VName ParamType]
    -> [PatBase NoInfo VName ParamType])
-> [PatBase NoInfo VName ParamType]
-> TypeM a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PatBase NoInfo VName ParamType
p' :))

-- | @resolveTypeParams ps m@ resolves the type parameters @ps@, then
-- invokes the continuation @m@ with the resolveed parameters, while
-- extending the monadic name map with @ps@.
resolveTypeParams ::
  [TypeParamBase Name] -> ([TypeParamBase VName] -> TypeM a) -> TypeM a
resolveTypeParams :: forall a.
[UncheckedTypeParam]
-> ([TypeParamBase VName] -> TypeM a) -> TypeM a
resolveTypeParams [UncheckedTypeParam]
ps [TypeParamBase VName] -> TypeM a
m =
  [(Namespace, Name, SrcLoc)] -> ([VName] -> TypeM a) -> TypeM a
forall a.
[(Namespace, Name, SrcLoc)] -> ([VName] -> TypeM a) -> TypeM a
bindSpaced ((UncheckedTypeParam -> (Namespace, Name, SrcLoc))
-> [UncheckedTypeParam] -> [(Namespace, Name, SrcLoc)]
forall a b. (a -> b) -> [a] -> [b]
map UncheckedTypeParam -> (Namespace, Name, SrcLoc)
forall {b}. TypeParamBase b -> (Namespace, b, SrcLoc)
typeParamSpace [UncheckedTypeParam]
ps) (([VName] -> TypeM a) -> TypeM a)
-> ([VName] -> TypeM a) -> TypeM a
forall a b. (a -> b) -> a -> b
$ \[VName]
_ ->
    [TypeParamBase VName] -> TypeM a
m ([TypeParamBase VName] -> TypeM a)
-> TypeM [TypeParamBase VName] -> TypeM a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< StateT (Map (Namespace, Name) SrcLoc) TypeM [TypeParamBase VName]
-> Map (Namespace, Name) SrcLoc -> TypeM [TypeParamBase VName]
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT ((UncheckedTypeParam
 -> StateT
      (Map (Namespace, Name) SrcLoc) TypeM (TypeParamBase VName))
-> [UncheckedTypeParam]
-> StateT
     (Map (Namespace, Name) SrcLoc) TypeM [TypeParamBase VName]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM UncheckedTypeParam
-> StateT
     (Map (Namespace, Name) SrcLoc) TypeM (TypeParamBase VName)
forall {t :: (* -> *) -> * -> *}.
(MonadTrans t,
 MonadState (Map (Namespace, Name) SrcLoc) (t TypeM)) =>
UncheckedTypeParam -> t TypeM (TypeParamBase VName)
checkTypeParam [UncheckedTypeParam]
ps) Map (Namespace, Name) SrcLoc
forall a. Monoid a => a
mempty
  where
    typeParamSpace :: TypeParamBase b -> (Namespace, b, SrcLoc)
typeParamSpace (TypeParamDim b
pv SrcLoc
loc) = (Namespace
Term, b
pv, SrcLoc
loc)
    typeParamSpace (TypeParamType Liftedness
_ b
pv SrcLoc
loc) = (Namespace
Type, b
pv, SrcLoc
loc)

    checkParamName :: Namespace -> Name -> SrcLoc -> t TypeM VName
checkParamName Namespace
ns Name
v SrcLoc
loc = do
      Maybe SrcLoc
seen <- (Map (Namespace, Name) SrcLoc -> Maybe SrcLoc)
-> t TypeM (Maybe SrcLoc)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ((Map (Namespace, Name) SrcLoc -> Maybe SrcLoc)
 -> t TypeM (Maybe SrcLoc))
-> (Map (Namespace, Name) SrcLoc -> Maybe SrcLoc)
-> t TypeM (Maybe SrcLoc)
forall a b. (a -> b) -> a -> b
$ (Namespace, Name) -> Map (Namespace, Name) SrcLoc -> Maybe SrcLoc
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (Namespace
ns, Name
v)
      case Maybe SrcLoc
seen of
        Just SrcLoc
prev ->
          TypeM VName -> t TypeM VName
forall (m :: * -> *) a. Monad m => m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (TypeM VName -> t TypeM VName) -> TypeM VName -> t TypeM VName
forall a b. (a -> b) -> a -> b
$
            SrcLoc -> Notes -> Doc () -> TypeM VName
forall loc a. Located loc => loc -> Notes -> Doc () -> TypeM a
forall (m :: * -> *) loc a.
(MonadTypeChecker m, Located loc) =>
loc -> Notes -> Doc () -> m a
typeError SrcLoc
loc Notes
forall a. Monoid a => a
mempty (Doc () -> TypeM VName) -> Doc () -> TypeM VName
forall a b. (a -> b) -> a -> b
$
              Doc ()
"Type parameter"
                Doc () -> Doc () -> Doc ()
forall a. Doc a -> Doc a -> Doc a
<+> Doc () -> Doc ()
forall ann. Doc ann -> Doc ann
dquotes (Name -> Doc ()
forall a ann. Pretty a => a -> Doc ann
forall a. Name -> Doc a
pretty Name
v)
                Doc () -> Doc () -> Doc ()
forall a. Doc a -> Doc a -> Doc a
<+> Doc ()
"previously defined at"
                Doc () -> Doc () -> Doc ()
forall a. Doc a -> Doc a -> Doc a
<+> String -> Doc ()
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (SrcLoc -> String
forall a. Located a => a -> String
locStr SrcLoc
prev)
                Doc () -> Doc () -> Doc ()
forall a. Semigroup a => a -> a -> a
<> Doc ()
"."
        Maybe SrcLoc
Nothing -> do
          (Map (Namespace, Name) SrcLoc -> Map (Namespace, Name) SrcLoc)
-> t TypeM ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((Map (Namespace, Name) SrcLoc -> Map (Namespace, Name) SrcLoc)
 -> t TypeM ())
-> (Map (Namespace, Name) SrcLoc -> Map (Namespace, Name) SrcLoc)
-> t TypeM ()
forall a b. (a -> b) -> a -> b
$ (Namespace, Name)
-> SrcLoc
-> Map (Namespace, Name) SrcLoc
-> Map (Namespace, Name) SrcLoc
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert (Namespace
ns, Name
v) SrcLoc
loc
          TypeM VName -> t TypeM VName
forall (m :: * -> *) a. Monad m => m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (TypeM VName -> t TypeM VName) -> TypeM VName -> t TypeM VName
forall a b. (a -> b) -> a -> b
$ Namespace -> Name -> SrcLoc -> TypeM VName
checkName Namespace
ns Name
v SrcLoc
loc

    checkTypeParam :: UncheckedTypeParam -> t TypeM (TypeParamBase VName)
checkTypeParam (TypeParamDim Name
pv SrcLoc
loc) =
      VName -> SrcLoc -> TypeParamBase VName
forall vn. vn -> SrcLoc -> TypeParamBase vn
TypeParamDim (VName -> SrcLoc -> TypeParamBase VName)
-> t TypeM VName -> t TypeM (SrcLoc -> TypeParamBase VName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Namespace -> Name -> SrcLoc -> t TypeM VName
forall {t :: (* -> *) -> * -> *}.
(MonadTrans t,
 MonadState (Map (Namespace, Name) SrcLoc) (t TypeM)) =>
Namespace -> Name -> SrcLoc -> t TypeM VName
checkParamName Namespace
Term Name
pv SrcLoc
loc t TypeM (SrcLoc -> TypeParamBase VName)
-> t TypeM SrcLoc -> t TypeM (TypeParamBase VName)
forall a b. t TypeM (a -> b) -> t TypeM a -> t TypeM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SrcLoc -> t TypeM SrcLoc
forall a. a -> t TypeM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
loc
    checkTypeParam (TypeParamType Liftedness
l Name
pv SrcLoc
loc) =
      Liftedness -> VName -> SrcLoc -> TypeParamBase VName
forall vn. Liftedness -> vn -> SrcLoc -> TypeParamBase vn
TypeParamType Liftedness
l (VName -> SrcLoc -> TypeParamBase VName)
-> t TypeM VName -> t TypeM (SrcLoc -> TypeParamBase VName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Namespace -> Name -> SrcLoc -> t TypeM VName
forall {t :: (* -> *) -> * -> *}.
(MonadTrans t,
 MonadState (Map (Namespace, Name) SrcLoc) (t TypeM)) =>
Namespace -> Name -> SrcLoc -> t TypeM VName
checkParamName Namespace
Type Name
pv SrcLoc
loc t TypeM (SrcLoc -> TypeParamBase VName)
-> t TypeM SrcLoc -> t TypeM (TypeParamBase VName)
forall a b. t TypeM (a -> b) -> t TypeM a -> t TypeM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SrcLoc -> t TypeM SrcLoc
forall a. a -> t TypeM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
loc

resolveSizes :: [SizeBinder Name] -> ([SizeBinder VName] -> TypeM a) -> TypeM a
resolveSizes :: forall a.
[SizeBinder Name] -> ([SizeBinder VName] -> TypeM a) -> TypeM a
resolveSizes [] [SizeBinder VName] -> TypeM a
m = [SizeBinder VName] -> TypeM a
m [] -- Minor optimisation.
resolveSizes [SizeBinder Name]
sizes [SizeBinder VName] -> TypeM a
m = do
  ([(Name, SrcLoc)] -> SizeBinder Name -> TypeM [(Name, SrcLoc)])
-> [(Name, SrcLoc)] -> [SizeBinder Name] -> TypeM ()
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m ()
foldM_ [(Name, SrcLoc)] -> SizeBinder Name -> TypeM [(Name, SrcLoc)]
forall {a} {m :: * -> *}.
(Eq a, MonadTypeChecker m) =>
[(a, SrcLoc)] -> SizeBinder a -> m [(a, SrcLoc)]
lookForDuplicates [(Name, SrcLoc)]
forall a. Monoid a => a
mempty [SizeBinder Name]
sizes
  [(Namespace, Name, SrcLoc)] -> ([VName] -> TypeM a) -> TypeM a
forall a.
[(Namespace, Name, SrcLoc)] -> ([VName] -> TypeM a) -> TypeM a
bindSpaced ((SizeBinder Name -> (Namespace, Name, SrcLoc))
-> [SizeBinder Name] -> [(Namespace, Name, SrcLoc)]
forall a b. (a -> b) -> [a] -> [b]
map SizeBinder Name -> (Namespace, Name, SrcLoc)
forall {b}. SizeBinder b -> (Namespace, b, SrcLoc)
sizeWithSpace [SizeBinder Name]
sizes) (([VName] -> TypeM a) -> TypeM a)
-> ([VName] -> TypeM a) -> TypeM a
forall a b. (a -> b) -> a -> b
$ \[VName]
sizes' ->
    [SizeBinder VName] -> TypeM a
m ([SizeBinder VName] -> TypeM a) -> [SizeBinder VName] -> TypeM a
forall a b. (a -> b) -> a -> b
$ (VName -> SrcLoc -> SizeBinder VName)
-> [VName] -> [SrcLoc] -> [SizeBinder VName]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith VName -> SrcLoc -> SizeBinder VName
forall vn. vn -> SrcLoc -> SizeBinder vn
SizeBinder [VName]
sizes' ([SrcLoc] -> [SizeBinder VName]) -> [SrcLoc] -> [SizeBinder VName]
forall a b. (a -> b) -> a -> b
$ (SizeBinder Name -> SrcLoc) -> [SizeBinder Name] -> [SrcLoc]
forall a b. (a -> b) -> [a] -> [b]
map SizeBinder Name -> SrcLoc
forall a. Located a => a -> SrcLoc
srclocOf [SizeBinder Name]
sizes
  where
    lookForDuplicates :: [(a, SrcLoc)] -> SizeBinder a -> m [(a, SrcLoc)]
lookForDuplicates [(a, SrcLoc)]
prev SizeBinder a
size
      | Just (a
_, SrcLoc
prevloc) <- ((a, SrcLoc) -> Bool) -> [(a, SrcLoc)] -> Maybe (a, SrcLoc)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
L.find ((a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== SizeBinder a -> a
forall vn. SizeBinder vn -> vn
sizeName SizeBinder a
size) (a -> Bool) -> ((a, SrcLoc) -> a) -> (a, SrcLoc) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, SrcLoc) -> a
forall a b. (a, b) -> a
fst) [(a, SrcLoc)]
prev =
          SizeBinder a -> Notes -> Doc () -> m [(a, SrcLoc)]
forall loc a. Located loc => loc -> Notes -> Doc () -> m a
forall (m :: * -> *) loc a.
(MonadTypeChecker m, Located loc) =>
loc -> Notes -> Doc () -> m a
typeError SizeBinder a
size Notes
forall a. Monoid a => a
mempty (Doc () -> m [(a, SrcLoc)]) -> Doc () -> m [(a, SrcLoc)]
forall a b. (a -> b) -> a -> b
$
            Doc ()
"Size name also bound at "
              Doc () -> Doc () -> Doc ()
forall a. Semigroup a => a -> a -> a
<> String -> Doc ()
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (SrcLoc -> SrcLoc -> String
forall a b. (Located a, Located b) => a -> b -> String
locStrRel (SizeBinder a -> SrcLoc
forall a. Located a => a -> SrcLoc
srclocOf SizeBinder a
size) SrcLoc
prevloc)
              Doc () -> Doc () -> Doc ()
forall a. Semigroup a => a -> a -> a
<> Doc ()
"."
      | Bool
otherwise =
          [(a, SrcLoc)] -> m [(a, SrcLoc)]
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([(a, SrcLoc)] -> m [(a, SrcLoc)])
-> [(a, SrcLoc)] -> m [(a, SrcLoc)]
forall a b. (a -> b) -> a -> b
$ (SizeBinder a -> a
forall vn. SizeBinder vn -> vn
sizeName SizeBinder a
size, SizeBinder a -> SrcLoc
forall a. Located a => a -> SrcLoc
srclocOf SizeBinder a
size) (a, SrcLoc) -> [(a, SrcLoc)] -> [(a, SrcLoc)]
forall a. a -> [a] -> [a]
: [(a, SrcLoc)]
prev

    sizeWithSpace :: SizeBinder b -> (Namespace, b, SrcLoc)
sizeWithSpace SizeBinder b
size =
      (Namespace
Term, SizeBinder b -> b
forall vn. SizeBinder vn -> vn
sizeName SizeBinder b
size, SizeBinder b -> SrcLoc
forall a. Located a => a -> SrcLoc
srclocOf SizeBinder b
size)

-- | Resolve names in a value binding. If this succeeds, then it is
-- guaranteed that all names references things that are in scope.
resolveValBind :: ValBindBase NoInfo Name -> TypeM (ValBindBase NoInfo VName)
resolveValBind :: ValBindBase NoInfo Name -> TypeM (ValBindBase NoInfo VName)
resolveValBind (ValBind Maybe (NoInfo EntryPoint)
entry Name
fname Maybe (TypeExp (ExpBase NoInfo Name) Name)
ret NoInfo ResRetType
NoInfo [UncheckedTypeParam]
tparams [PatBase NoInfo Name ParamType]
params ExpBase NoInfo Name
body Maybe DocComment
doc [AttrInfo Name]
attrs SrcLoc
loc) = do
  [AttrInfo VName]
attrs' <- (AttrInfo Name -> TypeM (AttrInfo VName))
-> [AttrInfo Name] -> TypeM [AttrInfo VName]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM AttrInfo Name -> TypeM (AttrInfo VName)
resolveAttrInfo [AttrInfo Name]
attrs
  [UncheckedTypeParam] -> [PatBase NoInfo Name ParamType] -> TypeM ()
forall (m :: * -> *) t.
MonadTypeChecker m =>
[UncheckedTypeParam] -> [UncheckedPat t] -> m ()
checkForDuplicateNames [UncheckedTypeParam]
tparams [PatBase NoInfo Name ParamType]
params
  SrcLoc -> Name -> TypeM ()
forall a. Located a => a -> Name -> TypeM ()
checkDoNotShadow SrcLoc
loc Name
fname
  [UncheckedTypeParam]
-> ([TypeParamBase VName] -> TypeM (ValBindBase NoInfo VName))
-> TypeM (ValBindBase NoInfo VName)
forall a.
[UncheckedTypeParam]
-> ([TypeParamBase VName] -> TypeM a) -> TypeM a
resolveTypeParams [UncheckedTypeParam]
tparams (([TypeParamBase VName] -> TypeM (ValBindBase NoInfo VName))
 -> TypeM (ValBindBase NoInfo VName))
-> ([TypeParamBase VName] -> TypeM (ValBindBase NoInfo VName))
-> TypeM (ValBindBase NoInfo VName)
forall a b. (a -> b) -> a -> b
$ \[TypeParamBase VName]
tparams' ->
    [PatBase NoInfo Name ParamType]
-> ([PatBase NoInfo VName ParamType]
    -> TypeM (ValBindBase NoInfo VName))
-> TypeM (ValBindBase NoInfo VName)
forall a.
[PatBase NoInfo Name ParamType]
-> ([PatBase NoInfo VName ParamType] -> TypeM a) -> TypeM a
resolveParams [PatBase NoInfo Name ParamType]
params (([PatBase NoInfo VName ParamType]
  -> TypeM (ValBindBase NoInfo VName))
 -> TypeM (ValBindBase NoInfo VName))
-> ([PatBase NoInfo VName ParamType]
    -> TypeM (ValBindBase NoInfo VName))
-> TypeM (ValBindBase NoInfo VName)
forall a b. (a -> b) -> a -> b
$ \[PatBase NoInfo VName ParamType]
params' -> do
      Maybe (TypeExp (ExpBase NoInfo VName) VName)
ret' <- (TypeExp (ExpBase NoInfo Name) Name
 -> TypeM (TypeExp (ExpBase NoInfo VName) VName))
-> Maybe (TypeExp (ExpBase NoInfo Name) Name)
-> TypeM (Maybe (TypeExp (ExpBase NoInfo VName) VName))
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) -> Maybe a -> f (Maybe b)
traverse TypeExp (ExpBase NoInfo Name) Name
-> TypeM (TypeExp (ExpBase NoInfo VName) VName)
resolveTypeExp Maybe (TypeExp (ExpBase NoInfo Name) Name)
ret
      ExpBase NoInfo VName
body' <- ExpBase NoInfo Name -> TypeM (ExpBase NoInfo VName)
resolveExp ExpBase NoInfo Name
body
      Namespace
-> Name
-> SrcLoc
-> (VName -> TypeM (ValBindBase NoInfo VName))
-> TypeM (ValBindBase NoInfo VName)
forall a.
Namespace -> Name -> SrcLoc -> (VName -> TypeM a) -> TypeM a
bindSpaced1 Namespace
Term Name
fname SrcLoc
loc ((VName -> TypeM (ValBindBase NoInfo VName))
 -> TypeM (ValBindBase NoInfo VName))
-> (VName -> TypeM (ValBindBase NoInfo VName))
-> TypeM (ValBindBase NoInfo VName)
forall a b. (a -> b) -> a -> b
$ \VName
fname' -> do
        VName -> TypeM ()
usedName VName
fname'
        ValBindBase NoInfo VName -> TypeM (ValBindBase NoInfo VName)
forall a. a -> TypeM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ValBindBase NoInfo VName -> TypeM (ValBindBase NoInfo VName))
-> ValBindBase NoInfo VName -> TypeM (ValBindBase NoInfo VName)
forall a b. (a -> b) -> a -> b
$ Maybe (NoInfo EntryPoint)
-> VName
-> Maybe (TypeExp (ExpBase NoInfo VName) VName)
-> NoInfo ResRetType
-> [TypeParamBase VName]
-> [PatBase NoInfo VName ParamType]
-> ExpBase NoInfo VName
-> Maybe DocComment
-> [AttrInfo VName]
-> SrcLoc
-> ValBindBase NoInfo VName
forall (f :: * -> *) vn.
Maybe (f EntryPoint)
-> vn
-> Maybe (TypeExp (ExpBase f vn) vn)
-> f ResRetType
-> [TypeParamBase vn]
-> [PatBase f vn ParamType]
-> ExpBase f vn
-> Maybe DocComment
-> [AttrInfo vn]
-> SrcLoc
-> ValBindBase f vn
ValBind Maybe (NoInfo EntryPoint)
entry VName
fname' Maybe (TypeExp (ExpBase NoInfo VName) VName)
ret' NoInfo ResRetType
forall {k} (a :: k). NoInfo a
NoInfo [TypeParamBase VName]
tparams' [PatBase NoInfo VName ParamType]
params' ExpBase NoInfo VName
body' Maybe DocComment
doc [AttrInfo VName]
attrs' SrcLoc
loc