{-# LANGUAGE NondecreasingIndentation #-}

module Agda.TypeChecking.Rules.Application
  ( checkArguments
  , checkArguments_
  , checkApplication
  , inferApplication
  , checkProjAppToKnownPrincipalArg
  ) where

import Prelude hiding ( null )

import Control.Arrow (first)
import Control.Monad.Trans
import Control.Monad.Trans.Maybe
import Control.Monad.Reader

import Data.Maybe
import qualified Data.List as List
import Data.List.NonEmpty (NonEmpty(..))
import qualified Data.List.NonEmpty as NonEmpty
import Data.Either (partitionEithers)
import Data.Traversable (sequenceA)
import Data.Void
import qualified Data.IntSet as IntSet

import Agda.Interaction.Highlighting.Generate (storeDisambiguatedName)
import Agda.Interaction.Options

import qualified Agda.Syntax.Abstract as A
import Agda.Syntax.Abstract.Views as A
import qualified Agda.Syntax.Info as A
import Agda.Syntax.Concrete.Pretty () -- only Pretty instances
import Agda.Syntax.Common
import Agda.Syntax.Fixity
import Agda.Syntax.Internal as I
import Agda.Syntax.Position

import Agda.TypeChecking.Conversion
import Agda.TypeChecking.Constraints
import Agda.TypeChecking.Datatypes
import Agda.TypeChecking.Free
import Agda.TypeChecking.Free.Lazy (VarMap, lookupVarMap)
import Agda.TypeChecking.Implicit
import Agda.TypeChecking.Injectivity
import Agda.TypeChecking.Irrelevance
import Agda.TypeChecking.InstanceArguments (postponeInstanceConstraints)
import Agda.TypeChecking.Level
import Agda.TypeChecking.MetaVars
import Agda.TypeChecking.Names
import Agda.TypeChecking.Pretty
import Agda.TypeChecking.Primitive
import Agda.TypeChecking.Monad
import Agda.TypeChecking.Monad.Builtin
import Agda.TypeChecking.Records
import Agda.TypeChecking.Reduce
import Agda.TypeChecking.Rules.Def
import Agda.TypeChecking.Rules.Term
import Agda.TypeChecking.Substitute
import Agda.TypeChecking.Telescope

import Agda.Utils.Either
import Agda.Utils.Except
import Agda.Utils.Functor
import Agda.Utils.Lens
import Agda.Utils.List
import Agda.Utils.Maybe
import Agda.Utils.Monad
import Agda.Utils.Null
import Agda.Utils.Pretty ( prettyShow )
import Agda.Utils.Size
import Agda.Utils.Tuple

import Agda.Utils.Impossible

-----------------------------------------------------------------------------
-- * Applications
-----------------------------------------------------------------------------

-- | Ranges of checked arguments, where present.
type MaybeRanges = [Maybe Range]

-- | @checkApplication hd args e t@ checks an application.
--   Precondition: @Application hs args = appView e@
--
--   @checkApplication@ disambiguates constructors
--   (and continues to 'checkConstructorApplication')
--   and resolves pattern synonyms.
checkApplication :: Comparison -> A.Expr -> A.Args -> A.Expr -> Type -> TCM Term
checkApplication :: Comparison -> Expr -> Args -> Expr -> Type -> TCM Term
checkApplication Comparison
cmp Expr
hd Args
args Expr
e Type
t =
  Expr -> TCM Term -> TCM Term
forall a. Expr -> TCM a -> TCM a
turnOffExpandLastIfExistingMeta Expr
hd (TCM Term -> TCM Term) -> TCM Term -> TCM Term
forall a b. (a -> b) -> a -> b
$
  TCM Term -> TCM Term
forall a. TCM a -> TCM a
postponeInstanceConstraints (TCM Term -> TCM Term) -> TCM Term -> TCM Term
forall a b. (a -> b) -> a -> b
$ do
  VerboseKey -> VerboseLevel -> TCM Doc -> TCMT IO ()
forall (m :: * -> *).
MonadDebug m =>
VerboseKey -> VerboseLevel -> TCM Doc -> m ()
reportSDoc VerboseKey
"tc.check.app" VerboseLevel
20 (TCM Doc -> TCMT IO ()) -> TCM Doc -> TCMT IO ()
forall a b. (a -> b) -> a -> b
$ [TCM Doc] -> TCM Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
vcat
    [ TCM Doc
"checkApplication"
    , VerboseLevel -> TCM Doc -> TCM Doc
forall (m :: * -> *). Functor m => VerboseLevel -> m Doc -> m Doc
nest VerboseLevel
2 (TCM Doc -> TCM Doc) -> TCM Doc -> TCM Doc
forall a b. (a -> b) -> a -> b
$ TCM Doc
"hd   = " TCM Doc -> TCM Doc -> TCM Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> Expr -> TCM Doc
forall c a (m :: * -> *).
(Pretty c, ToConcrete a c, MonadAbsToCon m) =>
a -> m Doc
prettyA Expr
hd
    , VerboseLevel -> TCM Doc -> TCM Doc
forall (m :: * -> *). Functor m => VerboseLevel -> m Doc -> m Doc
nest VerboseLevel
2 (TCM Doc -> TCM Doc) -> TCM Doc -> TCM Doc
forall a b. (a -> b) -> a -> b
$ TCM Doc
"args = " TCM Doc -> TCM Doc -> TCM Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> [TCM Doc] -> TCM Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
sep ((NamedArg Expr -> TCM Doc) -> Args -> [TCM Doc]
forall a b. (a -> b) -> [a] -> [b]
map NamedArg Expr -> TCM Doc
forall c a (m :: * -> *).
(Pretty c, ToConcrete a c, MonadAbsToCon m) =>
a -> m Doc
prettyA Args
args)
    , VerboseLevel -> TCM Doc -> TCM Doc
forall (m :: * -> *). Functor m => VerboseLevel -> m Doc -> m Doc
nest VerboseLevel
2 (TCM Doc -> TCM Doc) -> TCM Doc -> TCM Doc
forall a b. (a -> b) -> a -> b
$ TCM Doc
"e    = " TCM Doc -> TCM Doc -> TCM Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> Expr -> TCM Doc
forall c a (m :: * -> *).
(Pretty c, ToConcrete a c, MonadAbsToCon m) =>
a -> m Doc
prettyA Expr
e
    , VerboseLevel -> TCM Doc -> TCM Doc
forall (m :: * -> *). Functor m => VerboseLevel -> m Doc -> m Doc
nest VerboseLevel
2 (TCM Doc -> TCM Doc) -> TCM Doc -> TCM Doc
forall a b. (a -> b) -> a -> b
$ TCM Doc
"t    = " TCM Doc -> TCM Doc -> TCM Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> Type -> TCM Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM Type
t
    ]
  VerboseKey -> VerboseLevel -> TCM Doc -> TCMT IO ()
forall (m :: * -> *).
MonadDebug m =>
VerboseKey -> VerboseLevel -> TCM Doc -> m ()
reportSDoc VerboseKey
"tc.check.app" VerboseLevel
70 (TCM Doc -> TCMT IO ()) -> TCM Doc -> TCMT IO ()
forall a b. (a -> b) -> a -> b
$ [TCM Doc] -> TCM Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
vcat
    [ TCM Doc
"checkApplication (raw)"
    , VerboseLevel -> TCM Doc -> TCM Doc
forall (m :: * -> *). Functor m => VerboseLevel -> m Doc -> m Doc
nest VerboseLevel
2 (TCM Doc -> TCM Doc) -> TCM Doc -> TCM Doc
forall a b. (a -> b) -> a -> b
$ VerboseKey -> TCM Doc
forall (m :: * -> *). Monad m => VerboseKey -> m Doc
text (VerboseKey -> TCM Doc) -> VerboseKey -> TCM Doc
forall a b. (a -> b) -> a -> b
$ VerboseKey
"hd   = " VerboseKey -> VerboseKey -> VerboseKey
forall a. [a] -> [a] -> [a]
++ Expr -> VerboseKey
forall a. Show a => a -> VerboseKey
show Expr
hd
    , VerboseLevel -> TCM Doc -> TCM Doc
forall (m :: * -> *). Functor m => VerboseLevel -> m Doc -> m Doc
nest VerboseLevel
2 (TCM Doc -> TCM Doc) -> TCM Doc -> TCM Doc
forall a b. (a -> b) -> a -> b
$ VerboseKey -> TCM Doc
forall (m :: * -> *). Monad m => VerboseKey -> m Doc
text (VerboseKey -> TCM Doc) -> VerboseKey -> TCM Doc
forall a b. (a -> b) -> a -> b
$ VerboseKey
"args = " VerboseKey -> VerboseKey -> VerboseKey
forall a. [a] -> [a] -> [a]
++ Args -> VerboseKey
forall a. Show a => a -> VerboseKey
show (Args -> Args
forall a. ExprLike a => a -> a
deepUnscope Args
args)
    , VerboseLevel -> TCM Doc -> TCM Doc
forall (m :: * -> *). Functor m => VerboseLevel -> m Doc -> m Doc
nest VerboseLevel
2 (TCM Doc -> TCM Doc) -> TCM Doc -> TCM Doc
forall a b. (a -> b) -> a -> b
$ VerboseKey -> TCM Doc
forall (m :: * -> *). Monad m => VerboseKey -> m Doc
text (VerboseKey -> TCM Doc) -> VerboseKey -> TCM Doc
forall a b. (a -> b) -> a -> b
$ VerboseKey
"e    = " VerboseKey -> VerboseKey -> VerboseKey
forall a. [a] -> [a] -> [a]
++ Expr -> VerboseKey
forall a. Show a => a -> VerboseKey
show (Expr -> Expr
forall a. ExprLike a => a -> a
deepUnscope Expr
e)
    , VerboseLevel -> TCM Doc -> TCM Doc
forall (m :: * -> *). Functor m => VerboseLevel -> m Doc -> m Doc
nest VerboseLevel
2 (TCM Doc -> TCM Doc) -> TCM Doc -> TCM Doc
forall a b. (a -> b) -> a -> b
$ VerboseKey -> TCM Doc
forall (m :: * -> *). Monad m => VerboseKey -> m Doc
text (VerboseKey -> TCM Doc) -> VerboseKey -> TCM Doc
forall a b. (a -> b) -> a -> b
$ VerboseKey
"t    = " VerboseKey -> VerboseKey -> VerboseKey
forall a. [a] -> [a] -> [a]
++ Type -> VerboseKey
forall a. Show a => a -> VerboseKey
show Type
t
    ]
  case Expr -> Expr
unScope Expr
hd of
    -- Subcase: unambiguous projection
    A.Proj ProjOrigin
_ AmbiguousQName
p | Just QName
_ <- AmbiguousQName -> Maybe QName
getUnambiguous AmbiguousQName
p -> Comparison -> Expr -> Type -> Expr -> Args -> TCM Term
checkHeadApplication Comparison
cmp Expr
e Type
t Expr
hd Args
args

    -- Subcase: ambiguous projection
    A.Proj ProjOrigin
o AmbiguousQName
p -> Comparison
-> Expr -> ProjOrigin -> NonEmpty QName -> Args -> Type -> TCM Term
checkProjApp Comparison
cmp Expr
e ProjOrigin
o (AmbiguousQName -> NonEmpty QName
unAmbQ AmbiguousQName
p) Args
args Type
t

    -- Subcase: unambiguous constructor
    A.Con AmbiguousQName
ambC | Just QName
c <- AmbiguousQName -> Maybe QName
getUnambiguous AmbiguousQName
ambC -> do
      -- augment c with record fields, but do not revert to original name
      ConHead
con <- (SigError -> TCMT IO ConHead)
-> TCMT IO (Either SigError ConHead) -> TCMT IO ConHead
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> m (Either a b) -> m b
fromRightM ((VerboseKey -> TCMT IO ConHead)
-> TCMT IO ConHead -> SigError -> TCMT IO ConHead
forall a. (VerboseKey -> a) -> a -> SigError -> a
sigError VerboseKey -> TCMT IO ConHead
forall (m :: * -> *) a.
(HasCallStack, MonadDebug m) =>
VerboseKey -> m a
__IMPOSSIBLE_VERBOSE__ (TypeError -> TCMT IO ConHead
forall (m :: * -> *) a.
(MonadTCEnv m, ReadTCState m, MonadError TCErr m) =>
TypeError -> m a
typeError (TypeError -> TCMT IO ConHead) -> TypeError -> TCMT IO ConHead
forall a b. (a -> b) -> a -> b
$ QName -> TypeError
AbstractConstructorNotInScope QName
c)) (TCMT IO (Either SigError ConHead) -> TCMT IO ConHead)
-> TCMT IO (Either SigError ConHead) -> TCMT IO ConHead
forall a b. (a -> b) -> a -> b
$
        QName -> TCMT IO (Either SigError ConHead)
getOrigConHead QName
c
      Comparison -> Expr -> Type -> ConHead -> Args -> TCM Term
checkConstructorApplication Comparison
cmp Expr
e Type
t ConHead
con Args
args

    -- Subcase: ambiguous constructor
    A.Con (AmbQ NonEmpty QName
cs0) -> NonEmpty QName -> Type -> TCM (Either (TCM Bool) ConHead)
disambiguateConstructor NonEmpty QName
cs0 Type
t TCM (Either (TCM Bool) ConHead)
-> (Either (TCM Bool) ConHead -> TCM Term) -> TCM Term
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ case
      Left TCM Bool
unblock -> TypeCheckingProblem -> TCM Bool -> TCM Term
postponeTypeCheckingProblem (Comparison -> Expr -> Type -> TypeCheckingProblem
CheckExpr Comparison
cmp Expr
e Type
t) TCM Bool
unblock
      Right ConHead
c      -> Comparison -> Expr -> Type -> ConHead -> Args -> TCM Term
checkConstructorApplication Comparison
cmp Expr
e Type
t ConHead
c Args
args

    -- Subcase: pattern synonym
    A.PatternSyn AmbiguousQName
n -> do
      ([Arg Name]
ns, Pattern' Void
p) <- AmbiguousQName -> TCM ([Arg Name], Pattern' Void)
lookupPatternSyn AmbiguousQName
n
      Pattern' Expr
p <- Pattern' Expr -> TCMT IO (Pattern' Expr)
forall (m :: * -> *) a. Monad m => a -> m a
return (Pattern' Expr -> TCMT IO (Pattern' Expr))
-> Pattern' Expr -> TCMT IO (Pattern' Expr)
forall a b. (a -> b) -> a -> b
$ Range -> Pattern' Expr -> Pattern' Expr
forall t. SetRange t => Range -> t -> t
setRange (AmbiguousQName -> Range
forall t. HasRange t => t -> Range
getRange AmbiguousQName
n) (Pattern' Expr -> Pattern' Expr) -> Pattern' Expr -> Pattern' Expr
forall a b. (a -> b) -> a -> b
$ Pattern' Expr -> Pattern' Expr
forall a. KillRange a => KillRangeT a
killRange (Pattern' Expr -> Pattern' Expr) -> Pattern' Expr -> Pattern' Expr
forall a b. (a -> b) -> a -> b
$ Pattern' Void -> Pattern' Expr
forall (f :: * -> *) a. Functor f => f Void -> f a
vacuous Pattern' Void
p   -- Pattern' Void -> Pattern' Expr
      -- Expand the pattern synonym by substituting for
      -- the arguments we have got and lambda-lifting
      -- over the ones we haven't.
      let meta :: Range -> Expr
meta Range
r = MetaInfo -> Expr
A.Underscore (MetaInfo -> Expr) -> MetaInfo -> Expr
forall a b. (a -> b) -> a -> b
$ MetaInfo
A.emptyMetaInfo{ metaRange :: Range
A.metaRange = Range
r }   -- TODO: name suggestion
      case (Range -> Expr)
-> Range
-> [Arg Name]
-> Args
-> Maybe ([(Name, Expr)], [Arg Name])
forall a.
HasRange a =>
(Range -> a)
-> Range
-> [Arg Name]
-> [NamedArg a]
-> Maybe ([(Name, a)], [Arg Name])
A.insertImplicitPatSynArgs Range -> Expr
meta (AmbiguousQName -> Range
forall t. HasRange t => t -> Range
getRange AmbiguousQName
n) [Arg Name]
ns Args
args of
        Maybe ([(Name, Expr)], [Arg Name])
Nothing      -> TypeError -> TCM Term
forall (m :: * -> *) a.
(MonadTCEnv m, ReadTCState m, MonadError TCErr m) =>
TypeError -> m a
typeError (TypeError -> TCM Term) -> TypeError -> TCM Term
forall a b. (a -> b) -> a -> b
$ AmbiguousQName -> TypeError
BadArgumentsToPatternSynonym AmbiguousQName
n
        Just ([(Name, Expr)]
s, [Arg Name]
ns) -> do
          let p' :: Expr
p' = Pattern' Expr -> Expr
A.patternToExpr Pattern' Expr
p
              e' :: Expr
e' = [Name] -> Expr -> Expr
A.lambdaLiftExpr ((Arg Name -> Name) -> [Arg Name] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map Arg Name -> Name
forall e. Arg e -> e
unArg [Arg Name]
ns) ([(Name, Expr)] -> Expr -> Expr
forall a. SubstExpr a => [(Name, Expr)] -> a -> a
A.substExpr [(Name, Expr)]
s Expr
p')
          Comparison -> Expr -> Type -> TCM Term
checkExpr' Comparison
cmp Expr
e' Type
t

    -- Subcase: macro
    A.Macro QName
x -> do
      -- First go: no parameters
      TelV Tele (Dom Type)
tel Type
_ <- Type -> TCMT IO (TelV Type)
forall (m :: * -> *).
(MonadReduce m, MonadAddContext m) =>
Type -> m (TelV Type)
telView (Type -> TCMT IO (TelV Type))
-> TCMT IO Type -> TCMT IO (TelV Type)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Type -> TCMT IO Type
forall a (m :: * -> *). (Normalise a, MonadReduce m) => a -> m a
normalise (Type -> TCMT IO Type)
-> (Definition -> Type) -> Definition -> TCMT IO Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Definition -> Type
defType (Definition -> TCMT IO Type) -> TCMT IO Definition -> TCMT IO Type
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Definition -> TCMT IO Definition
forall (m :: * -> *).
(Functor m, HasConstInfo m, HasOptions m, ReadTCState m,
 MonadTCEnv m, MonadDebug m) =>
Definition -> m Definition
instantiateDef (Definition -> TCMT IO Definition)
-> TCMT IO Definition -> TCMT IO Definition
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< QName -> TCMT IO Definition
forall (m :: * -> *). HasConstInfo m => QName -> m Definition
getConstInfo QName
x

      Term
tTerm <- TCM Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primAgdaTerm
      Term
tName <- TCM Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primQName

      let argTel :: [Dom (VerboseKey, Type)]
argTel   = [Dom (VerboseKey, Type)] -> [Dom (VerboseKey, Type)]
forall a. [a] -> [a]
init ([Dom (VerboseKey, Type)] -> [Dom (VerboseKey, Type)])
-> [Dom (VerboseKey, Type)] -> [Dom (VerboseKey, Type)]
forall a b. (a -> b) -> a -> b
$ Tele (Dom Type) -> [Dom (VerboseKey, Type)]
forall t. Tele (Dom t) -> [Dom (VerboseKey, t)]
telToList Tele (Dom Type)
tel -- last argument is the hole term

          -- inspect macro type to figure out if arguments need to be wrapped in quote/quoteTerm
          mkArg :: Type -> NamedArg A.Expr -> NamedArg A.Expr
          mkArg :: Type -> NamedArg Expr -> NamedArg Expr
mkArg Type
t NamedArg Expr
a | Type -> Term
forall t a. Type'' t a -> a
unEl Type
t Term -> Term -> Bool
forall a. Eq a => a -> a -> Bool
== Term
tTerm =
            ((Named NamedName Expr -> Named NamedName Expr)
-> NamedArg Expr -> NamedArg Expr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Named NamedName Expr -> Named NamedName Expr)
 -> NamedArg Expr -> NamedArg Expr)
-> ((Expr -> Expr) -> Named NamedName Expr -> Named NamedName Expr)
-> (Expr -> Expr)
-> NamedArg Expr
-> NamedArg Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Expr -> Expr) -> Named NamedName Expr -> Named NamedName Expr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap)
              (AppInfo -> Expr -> NamedArg Expr -> Expr
A.App (Range -> AppInfo
A.defaultAppInfo (NamedArg Expr -> Range
forall t. HasRange t => t -> Range
getRange NamedArg Expr
a)) (ExprInfo -> Expr
A.QuoteTerm ExprInfo
A.exprNoRange) (NamedArg Expr -> Expr) -> (Expr -> NamedArg Expr) -> Expr -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr -> NamedArg Expr
forall a. a -> NamedArg a
defaultNamedArg) NamedArg Expr
a
          mkArg Type
t NamedArg Expr
a | Type -> Term
forall t a. Type'' t a -> a
unEl Type
t Term -> Term -> Bool
forall a. Eq a => a -> a -> Bool
== Term
tName =
            ((Named NamedName Expr -> Named NamedName Expr)
-> NamedArg Expr -> NamedArg Expr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Named NamedName Expr -> Named NamedName Expr)
 -> NamedArg Expr -> NamedArg Expr)
-> ((Expr -> Expr) -> Named NamedName Expr -> Named NamedName Expr)
-> (Expr -> Expr)
-> NamedArg Expr
-> NamedArg Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Expr -> Expr) -> Named NamedName Expr -> Named NamedName Expr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap)
              (AppInfo -> Expr -> NamedArg Expr -> Expr
A.App (Range -> AppInfo
A.defaultAppInfo (NamedArg Expr -> Range
forall t. HasRange t => t -> Range
getRange NamedArg Expr
a)) (ExprInfo -> Expr
A.Quote ExprInfo
A.exprNoRange) (NamedArg Expr -> Expr) -> (Expr -> NamedArg Expr) -> Expr -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr -> NamedArg Expr
forall a. a -> NamedArg a
defaultNamedArg) NamedArg Expr
a
          mkArg Type
t NamedArg Expr
a | Bool
otherwise = NamedArg Expr
a

          makeArgs :: [Dom (String, Type)] -> [NamedArg A.Expr] -> ([NamedArg A.Expr], [NamedArg A.Expr])
          makeArgs :: [Dom (VerboseKey, Type)] -> Args -> (Args, Args)
makeArgs [] Args
args = ([], Args
args)
          makeArgs [Dom (VerboseKey, Type)]
_  []   = ([], [])
          makeArgs tel :: [Dom (VerboseKey, Type)]
tel@(Dom (VerboseKey, Type)
d : [Dom (VerboseKey, Type)]
_) (NamedArg Expr
arg : Args
args) =
            case NamedArg Expr -> [Dom (VerboseKey, Type)] -> ImplicitInsertion
forall e a. NamedArg e -> [Dom a] -> ImplicitInsertion
insertImplicit NamedArg Expr
arg [Dom (VerboseKey, Type)]
tel of
              ImplicitInsertion
NoInsertNeeded -> (Args -> Args) -> (Args, Args) -> (Args, Args)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (Type -> NamedArg Expr -> NamedArg Expr
mkArg ((VerboseKey, Type) -> Type
forall a b. (a, b) -> b
snd ((VerboseKey, Type) -> Type) -> (VerboseKey, Type) -> Type
forall a b. (a -> b) -> a -> b
$ Dom (VerboseKey, Type) -> (VerboseKey, Type)
forall t e. Dom' t e -> e
unDom Dom (VerboseKey, Type)
d) NamedArg Expr
arg NamedArg Expr -> Args -> Args
forall a. a -> [a] -> [a]
:) ((Args, Args) -> (Args, Args)) -> (Args, Args) -> (Args, Args)
forall a b. (a -> b) -> a -> b
$ [Dom (VerboseKey, Type)] -> Args -> (Args, Args)
makeArgs ([Dom (VerboseKey, Type)] -> [Dom (VerboseKey, Type)]
forall a. [a] -> [a]
tail [Dom (VerboseKey, Type)]
tel) Args
args
              ImpInsert [Dom ()]
is   -> [Dom (VerboseKey, Type)] -> Args -> (Args, Args)
makeArgs (VerboseLevel
-> [Dom (VerboseKey, Type)] -> [Dom (VerboseKey, Type)]
forall a. VerboseLevel -> [a] -> [a]
drop ([Dom ()] -> VerboseLevel
forall (t :: * -> *) a. Foldable t => t a -> VerboseLevel
length [Dom ()]
is) [Dom (VerboseKey, Type)]
tel) (NamedArg Expr
arg NamedArg Expr -> Args -> Args
forall a. a -> [a] -> [a]
: Args
args)
              ImplicitInsertion
BadImplicits   -> (NamedArg Expr
arg NamedArg Expr -> Args -> Args
forall a. a -> [a] -> [a]
: Args
args, [])  -- fail later in checkHeadApplication
              NoSuchName{}   -> (NamedArg Expr
arg NamedArg Expr -> Args -> Args
forall a. a -> [a] -> [a]
: Args
args, [])  -- ditto

          (Args
macroArgs, Args
otherArgs) = [Dom (VerboseKey, Type)] -> Args -> (Args, Args)
makeArgs [Dom (VerboseKey, Type)]
argTel Args
args
          unq :: Expr -> Expr
unq = AppInfo -> Expr -> NamedArg Expr -> Expr
A.App (Range -> AppInfo
A.defaultAppInfo (Range -> AppInfo) -> Range -> AppInfo
forall a b. (a -> b) -> a -> b
$ QName -> Args -> Range
forall u t. (HasRange u, HasRange t) => u -> t -> Range
fuseRange QName
x Args
args) (ExprInfo -> Expr
A.Unquote ExprInfo
A.exprNoRange) (NamedArg Expr -> Expr) -> (Expr -> NamedArg Expr) -> Expr -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr -> NamedArg Expr
forall a. a -> NamedArg a
defaultNamedArg

          desugared :: Expr
desugared = Expr -> Args -> Expr
A.app (Expr -> Expr
unq (Expr -> Expr) -> Expr -> Expr
forall a b. (a -> b) -> a -> b
$ AppView -> Expr
unAppView (AppView -> Expr) -> AppView -> Expr
forall a b. (a -> b) -> a -> b
$ Expr -> Args -> AppView
forall arg. Expr -> [NamedArg arg] -> AppView' arg
Application (QName -> Expr
A.Def QName
x) (Args -> AppView) -> Args -> AppView
forall a b. (a -> b) -> a -> b
$ Args
macroArgs) Args
otherArgs

      Comparison -> Expr -> Type -> TCM Term
checkExpr' Comparison
cmp Expr
desugared Type
t

    -- Subcase: unquote
    A.Unquote ExprInfo
_
      | [NamedArg Expr
arg] <- Args
args -> do
          (MetaId
_, Term
hole) <- RunMetaOccursCheck -> Comparison -> Type -> TCMT IO (MetaId, Term)
forall (m :: * -> *).
MonadMetaSolver m =>
RunMetaOccursCheck -> Comparison -> Type -> m (MetaId, Term)
newValueMeta RunMetaOccursCheck
RunMetaOccursCheck Comparison
CmpLeq Type
t
          Expr -> Term -> Type -> TCMT IO ()
unquoteM (NamedArg Expr -> Expr
forall a. NamedArg a -> a
namedArg NamedArg Expr
arg) Term
hole Type
t
          Term -> TCM Term
forall (m :: * -> *) a. Monad m => a -> m a
return Term
hole
      | NamedArg Expr
arg : Args
args <- Args
args -> do
          -- Example: unquote v a b : A
          --  Create meta H : (x : X) (y : Y x) → Z x y for the hole
          --  Check a : X, b : Y a
          --  Unify Z a b == A
          --  Run the tactic on H
          Tele (Dom Type)
tel    <- Args -> TCM (Tele (Dom Type))
forall a. [Arg a] -> TCM (Tele (Dom Type))
metaTel Args
args                    -- (x : X) (y : Y x)
          Type
target <- Tele (Dom Type) -> TCMT IO Type -> TCMT IO Type
forall b (m :: * -> *) a.
(AddContext b, MonadAddContext m) =>
b -> m a -> m a
addContext Tele (Dom Type)
tel TCMT IO Type
newTypeMeta_      -- Z x y
          let holeType :: Type
holeType = Tele (Dom Type) -> Type -> Type
telePi_ Tele (Dom Type)
tel Type
target         -- (x : X) (y : Y x) → Z x y
          (Just [Arg Term]
vs, Tele (Dom Type)
EmptyTel) <- ([Elim' Term] -> Maybe [Arg Term])
-> ([Elim' Term], Tele (Dom Type))
-> (Maybe [Arg Term], Tele (Dom Type))
forall a c b. (a -> c) -> (a, b) -> (c, b)
mapFst [Elim' Term] -> Maybe [Arg Term]
forall a. [Elim' a] -> Maybe [Arg a]
allApplyElims (([Elim' Term], Tele (Dom Type))
 -> (Maybe [Arg Term], Tele (Dom Type)))
-> TCMT IO ([Elim' Term], Tele (Dom Type))
-> TCMT IO (Maybe [Arg Term], Tele (Dom Type))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ExpandHidden
-> Range
-> Args
-> Tele (Dom Type)
-> TCMT IO ([Elim' Term], Tele (Dom Type))
checkArguments_ ExpandHidden
ExpandLast (Args -> Range
forall t. HasRange t => t -> Range
getRange Args
args) Args
args Tele (Dom Type)
tel
                                                    -- a b : (x : X) (y : Y x)
          let rho :: Substitution' Term
rho = [Term] -> [Term]
forall a. [a] -> [a]
reverse ((Arg Term -> Term) -> [Arg Term] -> [Term]
forall a b. (a -> b) -> [a] -> [b]
map Arg Term -> Term
forall e. Arg e -> e
unArg [Arg Term]
vs) [Term] -> Substitution' Term -> Substitution' Term
forall a. DeBruijn a => [a] -> Substitution' a -> Substitution' a
++# Substitution' Term
forall a. Substitution' a
IdS  -- [x := a, y := b]
          Type -> Type -> TCMT IO ()
forall (m :: * -> *). MonadConversion m => Type -> Type -> m ()
equalType (Substitution' Term -> Type -> Type
forall t a. Subst t a => Substitution' t -> a -> a
applySubst Substitution' Term
rho Type
target) Type
t       -- Z a b == A
          (MetaId
_, Term
hole) <- RunMetaOccursCheck -> Comparison -> Type -> TCMT IO (MetaId, Term)
forall (m :: * -> *).
MonadMetaSolver m =>
RunMetaOccursCheck -> Comparison -> Type -> m (MetaId, Term)
newValueMeta RunMetaOccursCheck
RunMetaOccursCheck Comparison
CmpLeq Type
holeType
          Expr -> Term -> Type -> TCMT IO ()
unquoteM (NamedArg Expr -> Expr
forall a. NamedArg a -> a
namedArg NamedArg Expr
arg) Term
hole Type
holeType
          Term -> TCM Term
forall (m :: * -> *) a. Monad m => a -> m a
return (Term -> TCM Term) -> Term -> TCM Term
forall a b. (a -> b) -> a -> b
$ Term -> [Arg Term] -> Term
forall t. Apply t => t -> [Arg Term] -> t
apply Term
hole [Arg Term]
vs
      where
        metaTel :: [Arg a] -> TCM Telescope
        metaTel :: [Arg a] -> TCM (Tele (Dom Type))
metaTel []           = Tele (Dom Type) -> TCM (Tele (Dom Type))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Tele (Dom Type)
forall a. Tele a
EmptyTel
        metaTel (Arg a
arg : [Arg a]
args) = do
          Type
a <- TCMT IO Type
newTypeMeta_
          let dom :: Dom Type
dom = Type
a Type -> Dom' Term a -> Dom Type
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Arg a -> Dom' Term a
forall a. Arg a -> Dom a
domFromArg Arg a
arg
          Dom Type -> Abs (Tele (Dom Type)) -> Tele (Dom Type)
forall a. a -> Abs (Tele a) -> Tele a
ExtendTel Dom Type
dom (Abs (Tele (Dom Type)) -> Tele (Dom Type))
-> (Tele (Dom Type) -> Abs (Tele (Dom Type)))
-> Tele (Dom Type)
-> Tele (Dom Type)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VerboseKey -> Tele (Dom Type) -> Abs (Tele (Dom Type))
forall a. VerboseKey -> a -> Abs a
Abs VerboseKey
"x" (Tele (Dom Type) -> Tele (Dom Type))
-> TCM (Tele (Dom Type)) -> TCM (Tele (Dom Type))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
            (VerboseKey, Dom Type)
-> TCM (Tele (Dom Type)) -> TCM (Tele (Dom Type))
forall b (m :: * -> *) a.
(AddContext b, MonadAddContext m) =>
b -> m a -> m a
addContext (VerboseKey
"x" :: String, Dom Type
dom) ([Arg a] -> TCM (Tele (Dom Type))
forall a. [Arg a] -> TCM (Tele (Dom Type))
metaTel [Arg a]
args)

    -- Subcase: defined symbol or variable.
    Expr
_ -> do
      Term
v <- Comparison -> Expr -> Type -> Expr -> Args -> TCM Term
checkHeadApplication Comparison
cmp Expr
e Type
t Expr
hd Args
args
      VerboseKey -> VerboseLevel -> TCM Doc -> TCMT IO ()
forall (m :: * -> *).
MonadDebug m =>
VerboseKey -> VerboseLevel -> TCM Doc -> m ()
reportSDoc VerboseKey
"tc.term.app" VerboseLevel
30 (TCM Doc -> TCMT IO ()) -> TCM Doc -> TCMT IO ()
forall a b. (a -> b) -> a -> b
$ [TCM Doc] -> TCM Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
vcat
        [ TCM Doc
"checkApplication: checkHeadApplication returned"
        , VerboseLevel -> TCM Doc -> TCM Doc
forall (m :: * -> *). Functor m => VerboseLevel -> m Doc -> m Doc
nest VerboseLevel
2 (TCM Doc -> TCM Doc) -> TCM Doc -> TCM Doc
forall a b. (a -> b) -> a -> b
$ TCM Doc
"v = " TCM Doc -> TCM Doc -> TCM Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> Term -> TCM Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM Term
v
        ]
      Term -> TCM Term
forall (m :: * -> *) a. Monad m => a -> m a
return Term
v

-- | Precondition: @Application hd args = appView e@.
inferApplication :: ExpandHidden -> A.Expr -> A.Args -> A.Expr -> TCM (Term, Type)
inferApplication :: ExpandHidden -> Expr -> Args -> Expr -> TCM (Term, Type)
inferApplication ExpandHidden
exh Expr
hd Args
args Expr
e | Bool -> Bool
not (Expr -> Bool
defOrVar Expr
hd) = do
  Type
t <- TCMT IO Type -> TCMT IO Type
forall (m :: * -> *) a.
(MonadTCEnv m, HasOptions m, MonadDebug m) =>
m a -> m a
workOnTypes (TCMT IO Type -> TCMT IO Type) -> TCMT IO Type -> TCMT IO Type
forall a b. (a -> b) -> a -> b
$ TCMT IO Type
newTypeMeta_
  Term
v <- Comparison -> Expr -> Type -> TCM Term
checkExpr' Comparison
CmpEq Expr
e Type
t
  (Term, Type) -> TCM (Term, Type)
forall (m :: * -> *) a. Monad m => a -> m a
return (Term
v, Type
t)
inferApplication ExpandHidden
exh Expr
hd Args
args Expr
e = TCM (Term, Type) -> TCM (Term, Type)
forall a. TCM a -> TCM a
postponeInstanceConstraints (TCM (Term, Type) -> TCM (Term, Type))
-> TCM (Term, Type) -> TCM (Term, Type)
forall a b. (a -> b) -> a -> b
$
  case Expr -> Expr
unScope Expr
hd of
    A.Proj ProjOrigin
o AmbiguousQName
p | AmbiguousQName -> Bool
isAmbiguous AmbiguousQName
p -> Expr -> ProjOrigin -> NonEmpty QName -> Args -> TCM (Term, Type)
inferProjApp Expr
e ProjOrigin
o (AmbiguousQName -> NonEmpty QName
unAmbQ AmbiguousQName
p) Args
args
    Expr
_ -> do
      ([Elim' Term] -> Term
f, Type
t0) <- Expr -> TCM ([Elim' Term] -> Term, Type)
inferHead Expr
hd
      let r :: Range
r = Expr -> Range
forall t. HasRange t => t -> Range
getRange Expr
hd
      Either
  (MaybeRanges, [Elim' Term], Args, Type)
  (MaybeRanges, [Elim' Term], Type, CheckedTarget)
res <- ExceptT
  (MaybeRanges, [Elim' Term], Args, Type)
  TCM
  (MaybeRanges, [Elim' Term], Type, CheckedTarget)
-> TCM
     (Either
        (MaybeRanges, [Elim' Term], Args, Type)
        (MaybeRanges, [Elim' Term], Type, CheckedTarget))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT
   (MaybeRanges, [Elim' Term], Args, Type)
   TCM
   (MaybeRanges, [Elim' Term], Type, CheckedTarget)
 -> TCM
      (Either
         (MaybeRanges, [Elim' Term], Args, Type)
         (MaybeRanges, [Elim' Term], Type, CheckedTarget)))
-> ExceptT
     (MaybeRanges, [Elim' Term], Args, Type)
     TCM
     (MaybeRanges, [Elim' Term], Type, CheckedTarget)
-> TCM
     (Either
        (MaybeRanges, [Elim' Term], Args, Type)
        (MaybeRanges, [Elim' Term], Type, CheckedTarget))
forall a b. (a -> b) -> a -> b
$ ExpandHidden
-> Range
-> Args
-> Type
-> Maybe Type
-> ExceptT
     (MaybeRanges, [Elim' Term], Args, Type)
     TCM
     (MaybeRanges, [Elim' Term], Type, CheckedTarget)
checkArgumentsE ExpandHidden
exh (Expr -> Range
forall t. HasRange t => t -> Range
getRange Expr
hd) Args
args Type
t0 Maybe Type
forall a. Maybe a
Nothing
      case Either
  (MaybeRanges, [Elim' Term], Args, Type)
  (MaybeRanges, [Elim' Term], Type, CheckedTarget)
res of
        Right (MaybeRanges
_, [Elim' Term]
vs, Type
t1, CheckedTarget
_) -> (,Type
t1) (Term -> (Term, Type)) -> TCM Term -> TCM (Term, Type)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term -> TCM Term
forall (m :: * -> *).
(HasConstInfo m, MonadReduce m) =>
Term -> m Term
unfoldInlined ([Elim' Term] -> Term
f [Elim' Term]
vs)
        Left (MaybeRanges, [Elim' Term], Args, Type)
problem -> do
          Type
t <- TCMT IO Type -> TCMT IO Type
forall (m :: * -> *) a.
(MonadTCEnv m, HasOptions m, MonadDebug m) =>
m a -> m a
workOnTypes (TCMT IO Type -> TCMT IO Type) -> TCMT IO Type -> TCMT IO Type
forall a b. (a -> b) -> a -> b
$ TCMT IO Type
newTypeMeta_
          Term
v <- (MaybeRanges, [Elim' Term], Args, Type)
-> ExpandHidden
-> Range
-> Args
-> Type
-> (MaybeRanges
    -> [Elim' Term] -> Type -> CheckedTarget -> TCM Term)
-> TCM Term
postponeArgs (MaybeRanges, [Elim' Term], Args, Type)
problem ExpandHidden
exh Range
r Args
args Type
t ((MaybeRanges -> [Elim' Term] -> Type -> CheckedTarget -> TCM Term)
 -> TCM Term)
-> (MaybeRanges
    -> [Elim' Term] -> Type -> CheckedTarget -> TCM Term)
-> TCM Term
forall a b. (a -> b) -> a -> b
$ \ MaybeRanges
_ [Elim' Term]
vs Type
_ CheckedTarget
_ -> Term -> TCM Term
forall (m :: * -> *).
(HasConstInfo m, MonadReduce m) =>
Term -> m Term
unfoldInlined ([Elim' Term] -> Term
f [Elim' Term]
vs)
          (Term, Type) -> TCM (Term, Type)
forall (m :: * -> *) a. Monad m => a -> m a
return (Term
v, Type
t)

-----------------------------------------------------------------------------
-- * Heads
-----------------------------------------------------------------------------

inferHeadDef :: ProjOrigin -> QName -> TCM (Elims -> Term, Type)
inferHeadDef :: ProjOrigin -> QName -> TCM ([Elim' Term] -> Term, Type)
inferHeadDef ProjOrigin
o QName
x = do
  Maybe Projection
proj <- QName -> TCMT IO (Maybe Projection)
forall (m :: * -> *).
HasConstInfo m =>
QName -> m (Maybe Projection)
isProjection QName
x
  Relevance
rel  <- ArgInfo -> Relevance
forall a. LensRelevance a => a -> Relevance
getRelevance (ArgInfo -> Relevance)
-> (Definition -> ArgInfo) -> Definition -> Relevance
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Definition -> ArgInfo
defArgInfo (Definition -> Relevance)
-> TCMT IO Definition -> TCMT IO Relevance
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> QName -> TCMT IO Definition
forall (m :: * -> *). HasConstInfo m => QName -> m Definition
getConstInfo QName
x
  let app :: [Arg Term] -> Term
app =
        case Maybe Projection
proj of
          Maybe Projection
Nothing -> \ [Arg Term]
args -> QName -> [Elim' Term] -> Term
Def QName
x ([Elim' Term] -> Term) -> [Elim' Term] -> Term
forall a b. (a -> b) -> a -> b
$ (Arg Term -> Elim' Term) -> [Arg Term] -> [Elim' Term]
forall a b. (a -> b) -> [a] -> [b]
map Arg Term -> Elim' Term
forall a. Arg a -> Elim' a
Apply [Arg Term]
args
          Just Projection
p  -> \ [Arg Term]
args -> Projection -> ProjOrigin -> Relevance -> [Arg Term] -> Term
projDropParsApply Projection
p ProjOrigin
o Relevance
rel [Arg Term]
args
  (Term -> [Elim' Term] -> Term)
-> (Term, Type) -> ([Elim' Term] -> Term, Type)
forall a c b. (a -> c) -> (a, b) -> (c, b)
mapFst Term -> [Elim' Term] -> Term
forall t. Apply t => t -> [Elim' Term] -> t
applyE ((Term, Type) -> ([Elim' Term] -> Term, Type))
-> TCM (Term, Type) -> TCM ([Elim' Term] -> Term, Type)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Arg Term] -> Term) -> QName -> TCM (Term, Type)
inferDef [Arg Term] -> Term
app QName
x

-- | Infer the type of a head thing (variable, function symbol, or constructor).
--   We return a function that applies the head to arguments.
--   This is because in case of a constructor we want to drop the parameters.
inferHead :: A.Expr -> TCM (Elims -> Term, Type)
inferHead :: Expr -> TCM ([Elim' Term] -> Term, Type)
inferHead Expr
e = do
  case Expr
e of
    A.Var Name
x -> do -- traceCall (InferVar x) $ do
      (Term
u, Dom Type
a) <- Name -> TCMT IO (Term, Dom Type)
forall (m :: * -> *).
(MonadFail m, MonadTCEnv m) =>
Name -> m (Term, Dom Type)
getVarInfo Name
x
      VerboseKey -> VerboseLevel -> TCM Doc -> TCMT IO ()
forall (m :: * -> *).
MonadDebug m =>
VerboseKey -> VerboseLevel -> TCM Doc -> m ()
reportSDoc VerboseKey
"tc.term.var" VerboseLevel
20 (TCM Doc -> TCMT IO ()) -> TCM Doc -> TCMT IO ()
forall a b. (a -> b) -> a -> b
$ [TCM Doc] -> TCM Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
hsep
        [ TCM Doc
"variable" , Name -> TCM Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM Name
x
        , TCM Doc
"(" , VerboseKey -> TCM Doc
forall (m :: * -> *). Monad m => VerboseKey -> m Doc
text (Term -> VerboseKey
forall a. Show a => a -> VerboseKey
show Term
u) , TCM Doc
")"
        , TCM Doc
"has type:" , Dom Type -> TCM Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM Dom Type
a
        ]
      Bool -> TCMT IO () -> TCMT IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Dom Type -> Bool
forall a. LensRelevance a => a -> Bool
usableRelevance Dom Type
a) (TCMT IO () -> TCMT IO ()) -> TCMT IO () -> TCMT IO ()
forall a b. (a -> b) -> a -> b
$
        TypeError -> TCMT IO ()
forall (m :: * -> *) a.
(MonadTCEnv m, ReadTCState m, MonadError TCErr m) =>
TypeError -> m a
typeError (TypeError -> TCMT IO ()) -> TypeError -> TCMT IO ()
forall a b. (a -> b) -> a -> b
$ Name -> TypeError
VariableIsIrrelevant Name
x
      -- Andreas, 2019-06-18, LAIM 2019, issue #3855:
      -- Conor McBride style quantity judgement:
      -- The available quantity for variable x must be below
      -- the required quantity to construct the term x.
      -- Note: this whole thing does not work for linearity, where we need some actual arithmetics.
      TCM Bool -> TCMT IO () -> TCMT IO ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
unlessM ((Dom Type -> Quantity
forall a. LensQuantity a => a -> Quantity
getQuantity Dom Type
a Quantity -> Quantity -> Bool
`moreQuantity`) (Quantity -> Bool) -> TCMT IO Quantity -> TCM Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (TCEnv -> Quantity) -> TCMT IO Quantity
forall (m :: * -> *) a. MonadTCEnv m => (TCEnv -> a) -> m a
asksTC TCEnv -> Quantity
forall a. LensQuantity a => a -> Quantity
getQuantity) (TCMT IO () -> TCMT IO ()) -> TCMT IO () -> TCMT IO ()
forall a b. (a -> b) -> a -> b
$
        TypeError -> TCMT IO ()
forall (m :: * -> *) a.
(MonadTCEnv m, ReadTCState m, MonadError TCErr m) =>
TypeError -> m a
typeError (TypeError -> TCMT IO ()) -> TypeError -> TCMT IO ()
forall a b. (a -> b) -> a -> b
$ Name -> TypeError
VariableIsErased Name
x

      Bool -> TCMT IO () -> TCMT IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Dom Type -> Bool
forall a. LensCohesion a => a -> Bool
usableCohesion Dom Type
a) (TCMT IO () -> TCMT IO ()) -> TCMT IO () -> TCMT IO ()
forall a b. (a -> b) -> a -> b
$
        TypeError -> TCMT IO ()
forall (m :: * -> *) a.
(MonadTCEnv m, ReadTCState m, MonadError TCErr m) =>
TypeError -> m a
typeError (TypeError -> TCMT IO ()) -> TypeError -> TCMT IO ()
forall a b. (a -> b) -> a -> b
$ Name -> Cohesion -> TypeError
VariableIsOfUnusableCohesion Name
x (Dom Type -> Cohesion
forall a. LensCohesion a => a -> Cohesion
getCohesion Dom Type
a)

      ([Elim' Term] -> Term, Type) -> TCM ([Elim' Term] -> Term, Type)
forall (m :: * -> *) a. Monad m => a -> m a
return (Term -> [Elim' Term] -> Term
forall t. Apply t => t -> [Elim' Term] -> t
applyE Term
u, Dom Type -> Type
forall t e. Dom' t e -> e
unDom Dom Type
a)

    A.Def QName
x -> ProjOrigin -> QName -> TCM ([Elim' Term] -> Term, Type)
inferHeadDef ProjOrigin
ProjPrefix QName
x

    A.Proj ProjOrigin
o AmbiguousQName
ambP | Just QName
d <- AmbiguousQName -> Maybe QName
getUnambiguous AmbiguousQName
ambP -> ProjOrigin -> QName -> TCM ([Elim' Term] -> Term, Type)
inferHeadDef ProjOrigin
o QName
d
    A.Proj{} -> TCM ([Elim' Term] -> Term, Type)
forall a. HasCallStack => a
__IMPOSSIBLE__ -- inferHead will only be called on unambiguous projections

    A.Con AmbiguousQName
ambC | Just QName
c <- AmbiguousQName -> Maybe QName
getUnambiguous AmbiguousQName
ambC -> do

      -- Constructors are polymorphic internally.
      -- So, when building the constructor term
      -- we should throw away arguments corresponding to parameters.

      -- First, inferDef will try to apply the constructor
      -- to the free parameters of the current context. We ignore that.
      ConHead
con <- (SigError -> TCMT IO ConHead)
-> TCMT IO (Either SigError ConHead) -> TCMT IO ConHead
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> m (Either a b) -> m b
fromRightM ((VerboseKey -> TCMT IO ConHead)
-> TCMT IO ConHead -> SigError -> TCMT IO ConHead
forall a. (VerboseKey -> a) -> a -> SigError -> a
sigError VerboseKey -> TCMT IO ConHead
forall (m :: * -> *) a.
(HasCallStack, MonadDebug m) =>
VerboseKey -> m a
__IMPOSSIBLE_VERBOSE__ (TypeError -> TCMT IO ConHead
forall (m :: * -> *) a.
(MonadTCEnv m, ReadTCState m, MonadError TCErr m) =>
TypeError -> m a
typeError (TypeError -> TCMT IO ConHead) -> TypeError -> TCMT IO ConHead
forall a b. (a -> b) -> a -> b
$ QName -> TypeError
AbstractConstructorNotInScope QName
c)) (TCMT IO (Either SigError ConHead) -> TCMT IO ConHead)
-> TCMT IO (Either SigError ConHead) -> TCMT IO ConHead
forall a b. (a -> b) -> a -> b
$
        QName -> TCMT IO (Either SigError ConHead)
getOrigConHead QName
c
      (Term
u, Type
a) <- ([Arg Term] -> Term) -> QName -> TCM (Term, Type)
inferDef (\ [Arg Term]
_ -> ConHead -> ConInfo -> [Elim' Term] -> Term
Con ConHead
con ConInfo
ConOCon []) QName
c

      -- Next get the number of parameters in the current context.
      Constructor{conPars :: Defn -> VerboseLevel
conPars = VerboseLevel
n} <- Definition -> Defn
theDef (Definition -> Defn) -> TCMT IO Definition -> TCMT IO Defn
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Definition -> TCMT IO Definition
forall (m :: * -> *).
(Functor m, HasConstInfo m, HasOptions m, ReadTCState m,
 MonadTCEnv m, MonadDebug m) =>
Definition -> m Definition
instantiateDef (Definition -> TCMT IO Definition)
-> TCMT IO Definition -> TCMT IO Definition
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< QName -> TCMT IO Definition
forall (m :: * -> *). HasConstInfo m => QName -> m Definition
getConstInfo QName
c)

      VerboseKey -> VerboseLevel -> VerboseKey -> TCMT IO ()
forall (m :: * -> *).
MonadDebug m =>
VerboseKey -> VerboseLevel -> VerboseKey -> m ()
reportSLn VerboseKey
"tc.term.con" VerboseLevel
7 (VerboseKey -> TCMT IO ()) -> VerboseKey -> TCMT IO ()
forall a b. (a -> b) -> a -> b
$ [VerboseKey] -> VerboseKey
unwords [QName -> VerboseKey
forall a. Pretty a => a -> VerboseKey
prettyShow QName
c, VerboseKey
"has", VerboseLevel -> VerboseKey
forall a. Show a => a -> VerboseKey
show VerboseLevel
n, VerboseKey
"parameters."]

      -- So when applying the constructor throw away the parameters.
      ([Elim' Term] -> Term, Type) -> TCM ([Elim' Term] -> Term, Type)
forall (m :: * -> *) a. Monad m => a -> m a
return (Term -> [Elim' Term] -> Term
forall t. Apply t => t -> [Elim' Term] -> t
applyE Term
u ([Elim' Term] -> Term)
-> ([Elim' Term] -> [Elim' Term]) -> [Elim' Term] -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VerboseLevel -> [Elim' Term] -> [Elim' Term]
forall a. VerboseLevel -> [a] -> [a]
drop VerboseLevel
n, Type
a)
    A.Con{} -> TCM ([Elim' Term] -> Term, Type)
forall a. HasCallStack => a
__IMPOSSIBLE__  -- inferHead will only be called on unambiguous constructors
    A.QuestionMark MetaInfo
i InteractionId
ii -> (Comparison -> Type -> TCMT IO (MetaId, Term))
-> MetaInfo -> TCM ([Elim' Term] -> Term, Type)
inferMeta (InteractionId -> Comparison -> Type -> TCMT IO (MetaId, Term)
newQuestionMark InteractionId
ii) MetaInfo
i
    A.Underscore MetaInfo
i   -> (Comparison -> Type -> TCMT IO (MetaId, Term))
-> MetaInfo -> TCM ([Elim' Term] -> Term, Type)
inferMeta (RunMetaOccursCheck -> Comparison -> Type -> TCMT IO (MetaId, Term)
forall (m :: * -> *).
MonadMetaSolver m =>
RunMetaOccursCheck -> Comparison -> Type -> m (MetaId, Term)
newValueMeta RunMetaOccursCheck
RunMetaOccursCheck) MetaInfo
i
    Expr
e -> do
      (Term
term, Type
t) <- Expr -> TCM (Term, Type)
inferExpr Expr
e
      ([Elim' Term] -> Term, Type) -> TCM ([Elim' Term] -> Term, Type)
forall (m :: * -> *) a. Monad m => a -> m a
return (Term -> [Elim' Term] -> Term
forall t. Apply t => t -> [Elim' Term] -> t
applyE Term
term, Type
t)

inferDef :: (Args -> Term) -> QName -> TCM (Term, Type)
inferDef :: ([Arg Term] -> Term) -> QName -> TCM (Term, Type)
inferDef [Arg Term] -> Term
mkTerm QName
x =
  Call -> TCM (Term, Type) -> TCM (Term, Type)
forall (tcm :: * -> *) a.
(MonadTCM tcm, ReadTCState tcm, MonadDebug tcm) =>
Call -> tcm a -> tcm a
traceCall (QName -> Call
InferDef QName
x) (TCM (Term, Type) -> TCM (Term, Type))
-> TCM (Term, Type) -> TCM (Term, Type)
forall a b. (a -> b) -> a -> b
$ do
    -- getConstInfo retrieves the *absolute* (closed) type of x
    -- instantiateDef relativizes it to the current context
    Definition
d0 <- QName -> TCMT IO Definition
forall (m :: * -> *). HasConstInfo m => QName -> m Definition
getConstInfo QName
x
    Definition
d  <- Definition -> TCMT IO Definition
forall (m :: * -> *).
(Functor m, HasConstInfo m, HasOptions m, ReadTCState m,
 MonadTCEnv m, MonadDebug m) =>
Definition -> m Definition
instantiateDef Definition
d0
    VerboseKey -> VerboseLevel -> TCM Doc -> TCMT IO ()
forall (m :: * -> *).
MonadDebug m =>
VerboseKey -> VerboseLevel -> TCM Doc -> m ()
reportSDoc VerboseKey
"tc.term.def" VerboseLevel
10 (TCM Doc -> TCMT IO ()) -> TCM Doc -> TCMT IO ()
forall a b. (a -> b) -> a -> b
$ TCM Doc
"inferDef" TCM Doc -> TCM Doc -> TCM Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> QName -> TCM Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM QName
x
    VerboseKey -> VerboseLevel -> TCM Doc -> TCMT IO ()
forall (m :: * -> *).
MonadDebug m =>
VerboseKey -> VerboseLevel -> TCM Doc -> m ()
reportSDoc VerboseKey
"tc.term.def" VerboseLevel
30 (TCM Doc -> TCMT IO ()) -> TCM Doc -> TCMT IO ()
forall a b. (a -> b) -> a -> b
$ TCM Doc
"  absolute type:    " TCM Doc -> TCM Doc -> TCM Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> TCM Doc -> TCM Doc
forall (tcm :: * -> *) a.
(MonadTCEnv tcm, ReadTCState tcm) =>
tcm a -> tcm a
inTopContext (Type -> TCM Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM (Type -> TCM Doc) -> Type -> TCM Doc
forall a b. (a -> b) -> a -> b
$ Definition -> Type
defType Definition
d0)
    VerboseKey -> VerboseLevel -> TCM Doc -> TCMT IO ()
forall (m :: * -> *).
MonadDebug m =>
VerboseKey -> VerboseLevel -> TCM Doc -> m ()
reportSDoc VerboseKey
"tc.term.def" VerboseLevel
30 (TCM Doc -> TCMT IO ()) -> TCM Doc -> TCMT IO ()
forall a b. (a -> b) -> a -> b
$ TCM Doc
"  instantiated type:" TCM Doc -> TCM Doc -> TCM Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> Type -> TCM Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM (Definition -> Type
defType Definition
d)
    -- Irrelevant defs are only allowed in irrelevant position.
    -- Erased defs are only allowed in erased position (see #3855).
    QName -> Definition -> TCMT IO ()
checkModality QName
x Definition
d
    case Definition -> Defn
theDef Definition
d of
      GeneralizableVar{} -> do
        -- Generalizable variables corresponds to metas created
        -- at the point where they should be generalized. Module parameters
        -- have already been applied to the meta, so we don't have to do that
        -- here.
        GeneralizedValue
val <- GeneralizedValue -> Maybe GeneralizedValue -> GeneralizedValue
forall a. a -> Maybe a -> a
fromMaybe GeneralizedValue
forall a. HasCallStack => a
__IMPOSSIBLE__ (Maybe GeneralizedValue -> GeneralizedValue)
-> TCMT IO (Maybe GeneralizedValue) -> TCMT IO GeneralizedValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Lens' (Maybe GeneralizedValue) TCEnv
-> TCMT IO (Maybe GeneralizedValue)
forall (m :: * -> *) a. MonadTCEnv m => Lens' a TCEnv -> m a
viewTC ((Map QName GeneralizedValue -> f (Map QName GeneralizedValue))
-> TCEnv -> f TCEnv
Lens' (Map QName GeneralizedValue) TCEnv
eGeneralizedVars ((Map QName GeneralizedValue -> f (Map QName GeneralizedValue))
 -> TCEnv -> f TCEnv)
-> ((Maybe GeneralizedValue -> f (Maybe GeneralizedValue))
    -> Map QName GeneralizedValue -> f (Map QName GeneralizedValue))
-> (Maybe GeneralizedValue -> f (Maybe GeneralizedValue))
-> TCEnv
-> f TCEnv
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QName
-> Lens' (Maybe GeneralizedValue) (Map QName GeneralizedValue)
forall k v. Ord k => k -> Lens' (Maybe v) (Map k v)
key QName
x)
        Substitution' Term
sub <- CheckpointId -> TCMT IO (Substitution' Term)
forall (tcm :: * -> *).
MonadTCEnv tcm =>
CheckpointId -> tcm (Substitution' Term)
checkpointSubstitution (GeneralizedValue -> CheckpointId
genvalCheckpoint GeneralizedValue
val)
        let (Term
v, Type
t) = Substitution' Term -> (Term, Type) -> (Term, Type)
forall t a. Subst t a => Substitution' t -> a -> a
applySubst Substitution' Term
sub (GeneralizedValue -> Term
genvalTerm GeneralizedValue
val, GeneralizedValue -> Type
genvalType GeneralizedValue
val)
        [Arg Term] -> Type -> Term -> TCMT IO ()
debug [] Type
t Term
v
        (Term, Type) -> TCM (Term, Type)
forall (m :: * -> *) a. Monad m => a -> m a
return (Term
v, Type
t)
      Defn
_ -> do
        -- since x is considered living in the top-level, we have to
        -- apply it to the current context
        [Arg Term]
vs <- QName -> TCMT IO [Arg Term]
forall (m :: * -> *).
(Functor m, HasConstInfo m, HasOptions m, ReadTCState m,
 MonadTCEnv m, MonadDebug m) =>
QName -> m [Arg Term]
freeVarsToApply QName
x
        VerboseKey -> VerboseLevel -> TCM Doc -> TCMT IO ()
forall (m :: * -> *).
MonadDebug m =>
VerboseKey -> VerboseLevel -> TCM Doc -> m ()
reportSDoc VerboseKey
"tc.term.def" VerboseLevel
30 (TCM Doc -> TCMT IO ()) -> TCM Doc -> TCMT IO ()
forall a b. (a -> b) -> a -> b
$ TCM Doc
"  free vars:" TCM Doc -> TCM Doc -> TCM Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> [TCM Doc] -> TCM Doc
forall (m :: * -> *).
(Monad m, Semigroup (m Doc)) =>
[m Doc] -> m Doc
prettyList_ ((Arg Term -> TCM Doc) -> [Arg Term] -> [TCM Doc]
forall a b. (a -> b) -> [a] -> [b]
map Arg Term -> TCM Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM [Arg Term]
vs)
        let t :: Type
t = Definition -> Type
defType Definition
d
            v :: Term
v = [Arg Term] -> Term
mkTerm [Arg Term]
vs -- applies x to vs, dropping parameters

        -- Andrea 2019-07-16, Check that the supplied arguments
        -- respect the cohesion modalities of the current context.
        -- Cohesion is purely based on left-division, so it does not
        -- rely on "position" like Relevance/Quantity.
        [Arg Term] -> TCMT IO ()
checkCohesionArgs [Arg Term]
vs

        [Arg Term] -> Type -> Term -> TCMT IO ()
debug [Arg Term]
vs Type
t Term
v
        (Term, Type) -> TCM (Term, Type)
forall (m :: * -> *) a. Monad m => a -> m a
return (Term
v, Type
t)
  where
    debug :: Args -> Type -> Term -> TCM ()
    debug :: [Arg Term] -> Type -> Term -> TCMT IO ()
debug [Arg Term]
vs Type
t Term
v = do
      VerboseKey -> VerboseLevel -> TCM Doc -> TCMT IO ()
forall (m :: * -> *).
MonadDebug m =>
VerboseKey -> VerboseLevel -> TCM Doc -> m ()
reportSDoc VerboseKey
"tc.term.def" VerboseLevel
60 (TCM Doc -> TCMT IO ()) -> TCM Doc -> TCMT IO ()
forall a b. (a -> b) -> a -> b
$
        TCM Doc
"freeVarsToApply to def " TCM Doc -> TCM Doc -> TCM Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> [TCM Doc] -> TCM Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
hsep ((Arg Term -> TCM Doc) -> [Arg Term] -> [TCM Doc]
forall a b. (a -> b) -> [a] -> [b]
map (VerboseKey -> TCM Doc
forall (m :: * -> *). Monad m => VerboseKey -> m Doc
text (VerboseKey -> TCM Doc)
-> (Arg Term -> VerboseKey) -> Arg Term -> TCM Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Arg Term -> VerboseKey
forall a. Show a => a -> VerboseKey
show) [Arg Term]
vs)
      VerboseKey -> VerboseLevel -> TCM Doc -> TCMT IO ()
forall (m :: * -> *).
MonadDebug m =>
VerboseKey -> VerboseLevel -> TCM Doc -> m ()
reportSDoc VerboseKey
"tc.term.def" VerboseLevel
10 (TCM Doc -> TCMT IO ()) -> TCM Doc -> TCMT IO ()
forall a b. (a -> b) -> a -> b
$ [TCM Doc] -> TCM Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
vcat
        [ TCM Doc
"inferred def " TCM Doc -> TCM Doc -> TCM Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> QName -> TCM Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM QName
x TCM Doc -> TCM Doc -> TCM Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> [TCM Doc] -> TCM Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
hsep ((Arg Term -> TCM Doc) -> [Arg Term] -> [TCM Doc]
forall a b. (a -> b) -> [a] -> [b]
map Arg Term -> TCM Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM [Arg Term]
vs)
        , VerboseLevel -> TCM Doc -> TCM Doc
forall (m :: * -> *). Functor m => VerboseLevel -> m Doc -> m Doc
nest VerboseLevel
2 (TCM Doc -> TCM Doc) -> TCM Doc -> TCM Doc
forall a b. (a -> b) -> a -> b
$ TCM Doc
":" TCM Doc -> TCM Doc -> TCM Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> Type -> TCM Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM Type
t
        , VerboseLevel -> TCM Doc -> TCM Doc
forall (m :: * -> *). Functor m => VerboseLevel -> m Doc -> m Doc
nest VerboseLevel
2 (TCM Doc -> TCM Doc) -> TCM Doc -> TCM Doc
forall a b. (a -> b) -> a -> b
$ TCM Doc
"-->" TCM Doc -> TCM Doc -> TCM Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> Term -> TCM Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM Term
v ]

checkCohesionArgs :: Args -> TCM ()
checkCohesionArgs :: [Arg Term] -> TCMT IO ()
checkCohesionArgs [Arg Term]
vs = do
  let
    vmap :: VarMap
    vmap :: VarMap
vmap = [Arg Term] -> VarMap
forall a c t.
(IsVarSet a c, Singleton VerboseLevel c, Free t) =>
t -> c
freeVars [Arg Term]
vs

  -- we iterate over all vars in the context and their ArgInfo,
  -- checking for each that "vs" uses them as allowed.
  [Arg Term]
as <- TCMT IO [Arg Term]
forall (m :: * -> *). (Applicative m, MonadTCEnv m) => m [Arg Term]
getContextArgs
  [Arg Term] -> (Arg Term -> TCMT IO ()) -> TCMT IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Arg Term]
as ((Arg Term -> TCMT IO ()) -> TCMT IO ())
-> (Arg Term -> TCMT IO ()) -> TCMT IO ()
forall a b. (a -> b) -> a -> b
$ \ (Arg ArgInfo
avail Term
t) -> do
    let m :: Maybe Modality
m = do
          VerboseLevel
v <- Term -> Maybe VerboseLevel
forall a. DeBruijn a => a -> Maybe VerboseLevel
deBruijnView Term
t
          VarOcc' MetaSet -> Modality
forall a. VarOcc' a -> Modality
varModality (VarOcc' MetaSet -> Modality)
-> Maybe (VarOcc' MetaSet) -> Maybe Modality
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> VerboseLevel -> VarMap -> Maybe (VarOcc' MetaSet)
forall a. VerboseLevel -> VarMap' a -> Maybe (VarOcc' a)
lookupVarMap VerboseLevel
v VarMap
vmap
    Maybe Modality -> (Modality -> TCMT IO ()) -> TCMT IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe Modality
m ((Modality -> TCMT IO ()) -> TCMT IO ())
-> (Modality -> TCMT IO ()) -> TCMT IO ()
forall a b. (a -> b) -> a -> b
$ \ Modality
used -> do
        Bool -> TCMT IO () -> TCMT IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ArgInfo -> Cohesion
forall a. LensCohesion a => a -> Cohesion
getCohesion ArgInfo
avail Cohesion -> Cohesion -> Bool
`moreCohesion` Modality -> Cohesion
forall a. LensCohesion a => a -> Cohesion
getCohesion Modality
used) (TCMT IO () -> TCMT IO ()) -> TCMT IO () -> TCMT IO ()
forall a b. (a -> b) -> a -> b
$
           (Doc -> TCMT IO ()
forall (m :: * -> *) a.
(MonadTCEnv m, ReadTCState m, MonadError TCErr m) =>
Doc -> m a
genericDocError (Doc -> TCMT IO ()) -> TCM Doc -> TCMT IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (TCM Doc -> TCMT IO ()) -> TCM Doc -> TCMT IO ()
forall a b. (a -> b) -> a -> b
$ [TCM Doc] -> TCM Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
fsep ([TCM Doc] -> TCM Doc) -> [TCM Doc] -> TCM Doc
forall a b. (a -> b) -> a -> b
$
                [TCM Doc
"Variable" , Term -> TCM Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM Term
t]
             [TCM Doc] -> [TCM Doc] -> [TCM Doc]
forall a. [a] -> [a] -> [a]
++ VerboseKey -> [TCM Doc]
forall (m :: * -> *). Monad m => VerboseKey -> [m Doc]
pwords VerboseKey
"is used as" [TCM Doc] -> [TCM Doc] -> [TCM Doc]
forall a. [a] -> [a] -> [a]
++ [VerboseKey -> TCM Doc
forall (m :: * -> *). Monad m => VerboseKey -> m Doc
text (VerboseKey -> TCM Doc) -> VerboseKey -> TCM Doc
forall a b. (a -> b) -> a -> b
$ Cohesion -> VerboseKey
forall a. Show a => a -> VerboseKey
show (Cohesion -> VerboseKey) -> Cohesion -> VerboseKey
forall a b. (a -> b) -> a -> b
$ Modality -> Cohesion
forall a. LensCohesion a => a -> Cohesion
getCohesion Modality
used]
             [TCM Doc] -> [TCM Doc] -> [TCM Doc]
forall a. [a] -> [a] -> [a]
++ VerboseKey -> [TCM Doc]
forall (m :: * -> *). Monad m => VerboseKey -> [m Doc]
pwords VerboseKey
"but only available as" [TCM Doc] -> [TCM Doc] -> [TCM Doc]
forall a. [a] -> [a] -> [a]
++ [VerboseKey -> TCM Doc
forall (m :: * -> *). Monad m => VerboseKey -> m Doc
text (VerboseKey -> TCM Doc) -> VerboseKey -> TCM Doc
forall a b. (a -> b) -> a -> b
$ Cohesion -> VerboseKey
forall a. Show a => a -> VerboseKey
show (Cohesion -> VerboseKey) -> Cohesion -> VerboseKey
forall a b. (a -> b) -> a -> b
$ ArgInfo -> Cohesion
forall a. LensCohesion a => a -> Cohesion
getCohesion ArgInfo
avail]

-- | The second argument is the definition of the first.
--   Returns 'Nothing' if ok, otherwise the error message.
checkRelevance' :: QName -> Definition -> TCM (Maybe TypeError)
checkRelevance' :: QName -> Definition -> TCM (Maybe TypeError)
checkRelevance' QName
x Definition
def = do
  case Definition -> Relevance
forall a. LensRelevance a => a -> Relevance
getRelevance Definition
def of
    Relevance
Relevant -> Maybe TypeError -> TCM (Maybe TypeError)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe TypeError
forall a. Maybe a
Nothing -- relevance functions can be used in any context.
    Relevance
drel -> do
      -- Andreas,, 2018-06-09, issue #2170
      -- irrelevant projections are only allowed if --irrelevant-projections
      TCM Bool
-> TCM (Maybe TypeError)
-> TCM (Maybe TypeError)
-> TCM (Maybe TypeError)
forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifM (Bool -> TCM Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Projection -> Bool
forall a. Maybe a -> Bool
isJust (Maybe Projection -> Bool) -> Maybe Projection -> Bool
forall a b. (a -> b) -> a -> b
$ Defn -> Maybe Projection
isProjection_ (Defn -> Maybe Projection) -> Defn -> Maybe Projection
forall a b. (a -> b) -> a -> b
$ Definition -> Defn
theDef Definition
def) TCM Bool -> TCM Bool -> TCM Bool
forall (m :: * -> *). Monad m => m Bool -> m Bool -> m Bool
`and2M`
           (Bool -> Bool
not (Bool -> Bool) -> (PragmaOptions -> Bool) -> PragmaOptions -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.PragmaOptions -> Bool
optIrrelevantProjections (PragmaOptions -> Bool) -> TCMT IO PragmaOptions -> TCM Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TCMT IO PragmaOptions
forall (m :: * -> *). HasOptions m => m PragmaOptions
pragmaOptions)) {-then-} TCM (Maybe TypeError)
needIrrProj {-else-} (TCM (Maybe TypeError) -> TCM (Maybe TypeError))
-> TCM (Maybe TypeError) -> TCM (Maybe TypeError)
forall a b. (a -> b) -> a -> b
$ do
        Relevance
rel <- (TCEnv -> Relevance) -> TCMT IO Relevance
forall (m :: * -> *) a. MonadTCEnv m => (TCEnv -> a) -> m a
asksTC TCEnv -> Relevance
forall a. LensRelevance a => a -> Relevance
getRelevance
        VerboseKey -> VerboseLevel -> TCM Doc -> TCMT IO ()
forall (m :: * -> *).
MonadDebug m =>
VerboseKey -> VerboseLevel -> TCM Doc -> m ()
reportSDoc VerboseKey
"tc.irr" VerboseLevel
50 (TCM Doc -> TCMT IO ()) -> TCM Doc -> TCMT IO ()
forall a b. (a -> b) -> a -> b
$ [TCM Doc] -> TCM Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
vcat
          [ TCM Doc
"declaration relevance =" TCM Doc -> TCM Doc -> TCM Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> VerboseKey -> TCM Doc
forall (m :: * -> *). Monad m => VerboseKey -> m Doc
text (Relevance -> VerboseKey
forall a. Show a => a -> VerboseKey
show Relevance
drel)
          , TCM Doc
"context     relevance =" TCM Doc -> TCM Doc -> TCM Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> VerboseKey -> TCM Doc
forall (m :: * -> *). Monad m => VerboseKey -> m Doc
text (Relevance -> VerboseKey
forall a. Show a => a -> VerboseKey
show Relevance
rel)
          ]
        Maybe TypeError -> TCM (Maybe TypeError)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe TypeError -> TCM (Maybe TypeError))
-> Maybe TypeError -> TCM (Maybe TypeError)
forall a b. (a -> b) -> a -> b
$ if (Relevance
drel Relevance -> Relevance -> Bool
`moreRelevant` Relevance
rel) then Maybe TypeError
forall a. Maybe a
Nothing else TypeError -> Maybe TypeError
forall a. a -> Maybe a
Just (TypeError -> Maybe TypeError) -> TypeError -> Maybe TypeError
forall a b. (a -> b) -> a -> b
$ QName -> TypeError
DefinitionIsIrrelevant QName
x
  where
  needIrrProj :: TCM (Maybe TypeError)
needIrrProj = TypeError -> Maybe TypeError
forall a. a -> Maybe a
Just (TypeError -> Maybe TypeError)
-> (Doc -> TypeError) -> Doc -> Maybe TypeError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> TypeError
GenericDocError (Doc -> Maybe TypeError) -> TCM Doc -> TCM (Maybe TypeError)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
    [TCM Doc] -> TCM Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
sep [ TCM Doc
"Projection " , QName -> TCM Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM QName
x, TCM Doc
" is irrelevant."
        , TCM Doc
" Turn on option --irrelevant-projections to use it (unsafe)."
        ]

-- | The second argument is the definition of the first.
--   Returns 'Nothing' if ok, otherwise the error message.
checkQuantity' :: QName -> Definition -> TCM (Maybe TypeError)
checkQuantity' :: QName -> Definition -> TCM (Maybe TypeError)
checkQuantity' QName
x Definition
def = do
  case Definition -> Quantity
forall a. LensQuantity a => a -> Quantity
getQuantity Definition
def of
    Quantityω{} -> Maybe TypeError -> TCM (Maybe TypeError)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe TypeError
forall a. Maybe a
Nothing -- Abundant definitions can be used in any context.
    Quantity
dq -> do
      Quantity
q <- (TCEnv -> Quantity) -> TCMT IO Quantity
forall (m :: * -> *) a. MonadTCEnv m => (TCEnv -> a) -> m a
asksTC TCEnv -> Quantity
forall a. LensQuantity a => a -> Quantity
getQuantity
      VerboseKey -> VerboseLevel -> TCM Doc -> TCMT IO ()
forall (m :: * -> *).
MonadDebug m =>
VerboseKey -> VerboseLevel -> TCM Doc -> m ()
reportSDoc VerboseKey
"tc.irr" VerboseLevel
50 (TCM Doc -> TCMT IO ()) -> TCM Doc -> TCMT IO ()
forall a b. (a -> b) -> a -> b
$ [TCM Doc] -> TCM Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
vcat
        [ TCM Doc
"declaration quantity =" TCM Doc -> TCM Doc -> TCM Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> VerboseKey -> TCM Doc
forall (m :: * -> *). Monad m => VerboseKey -> m Doc
text (Quantity -> VerboseKey
forall a. Show a => a -> VerboseKey
show Quantity
dq)
        , TCM Doc
"context     quantity =" TCM Doc -> TCM Doc -> TCM Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> VerboseKey -> TCM Doc
forall (m :: * -> *). Monad m => VerboseKey -> m Doc
text (Quantity -> VerboseKey
forall a. Show a => a -> VerboseKey
show Quantity
q)
        ]
      Maybe TypeError -> TCM (Maybe TypeError)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe TypeError -> TCM (Maybe TypeError))
-> Maybe TypeError -> TCM (Maybe TypeError)
forall a b. (a -> b) -> a -> b
$ if (Quantity
dq Quantity -> Quantity -> Bool
`moreQuantity` Quantity
q) then Maybe TypeError
forall a. Maybe a
Nothing else TypeError -> Maybe TypeError
forall a. a -> Maybe a
Just (TypeError -> Maybe TypeError) -> TypeError -> Maybe TypeError
forall a b. (a -> b) -> a -> b
$ QName -> TypeError
DefinitionIsErased QName
x

-- | The second argument is the definition of the first.
checkModality' :: QName -> Definition -> TCM (Maybe TypeError)
checkModality' :: QName -> Definition -> TCM (Maybe TypeError)
checkModality' QName
x Definition
def = do
  QName -> Definition -> TCM (Maybe TypeError)
checkRelevance' QName
x Definition
def TCM (Maybe TypeError)
-> (Maybe TypeError -> TCM (Maybe TypeError))
-> TCM (Maybe TypeError)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Maybe TypeError
Nothing    -> QName -> Definition -> TCM (Maybe TypeError)
checkQuantity' QName
x Definition
def
    err :: Maybe TypeError
err@Just{} -> Maybe TypeError -> TCM (Maybe TypeError)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe TypeError
err

-- | The second argument is the definition of the first.
checkModality :: QName -> Definition -> TCM ()
checkModality :: QName -> Definition -> TCMT IO ()
checkModality QName
x Definition
def = TCM (Maybe TypeError) -> TCMT IO ()
forall (m :: * -> *).
(MonadTCEnv m, ReadTCState m, MonadError TCErr m) =>
m (Maybe TypeError) -> m ()
justToError (TCM (Maybe TypeError) -> TCMT IO ())
-> TCM (Maybe TypeError) -> TCMT IO ()
forall a b. (a -> b) -> a -> b
$ QName -> Definition -> TCM (Maybe TypeError)
checkModality' QName
x Definition
def
  where
  justToError :: m (Maybe TypeError) -> m ()
justToError m (Maybe TypeError)
m = m () -> (TypeError -> m ()) -> Maybe TypeError -> m ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) TypeError -> m ()
forall (m :: * -> *) a.
(MonadTCEnv m, ReadTCState m, MonadError TCErr m) =>
TypeError -> m a
typeError (Maybe TypeError -> m ()) -> m (Maybe TypeError) -> m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m (Maybe TypeError)
m

-- | @checkHeadApplication e t hd args@ checks that @e@ has type @t@,
-- assuming that @e@ has the form @hd args@. The corresponding
-- type-checked term is returned.
--
-- If the head term @hd@ is a coinductive constructor, then a
-- top-level definition @fresh tel = hd args@ (where the clause is
-- delayed) is added, where @tel@ corresponds to the current
-- telescope. The returned term is @fresh tel@.
--
-- Precondition: The head @hd@ has to be unambiguous, and there should
-- not be any need to insert hidden lambdas.
checkHeadApplication :: Comparison -> A.Expr -> Type -> A.Expr -> [NamedArg A.Expr] -> TCM Term
checkHeadApplication :: Comparison -> Expr -> Type -> Expr -> Args -> TCM Term
checkHeadApplication Comparison
cmp Expr
e Type
t Expr
hd Args
args = do
  Maybe QName
sharp <- (CoinductionKit -> QName) -> Maybe CoinductionKit -> Maybe QName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CoinductionKit -> QName
nameOfSharp (Maybe CoinductionKit -> Maybe QName)
-> TCMT IO (Maybe CoinductionKit) -> TCMT IO (Maybe QName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TCMT IO (Maybe CoinductionKit)
coinductionKit
  Maybe QName
conId  <- VerboseKey -> TCMT IO (Maybe QName)
forall (m :: * -> *).
HasBuiltins m =>
VerboseKey -> m (Maybe QName)
getNameOfConstrained VerboseKey
builtinConId
  Maybe QName
pOr    <- VerboseKey -> TCMT IO (Maybe QName)
forall (m :: * -> *).
HasBuiltins m =>
VerboseKey -> m (Maybe QName)
getNameOfConstrained VerboseKey
builtinPOr
  Maybe QName
pComp  <- VerboseKey -> TCMT IO (Maybe QName)
forall (m :: * -> *).
HasBuiltins m =>
VerboseKey -> m (Maybe QName)
getNameOfConstrained VerboseKey
builtinComp
  Maybe QName
pHComp <- VerboseKey -> TCMT IO (Maybe QName)
forall (m :: * -> *).
HasBuiltins m =>
VerboseKey -> m (Maybe QName)
getNameOfConstrained VerboseKey
builtinHComp
  Maybe QName
pTrans <- VerboseKey -> TCMT IO (Maybe QName)
forall (m :: * -> *).
HasBuiltins m =>
VerboseKey -> m (Maybe QName)
getNameOfConstrained VerboseKey
builtinTrans
  Maybe QName
mglue  <- VerboseKey -> TCMT IO (Maybe QName)
forall (m :: * -> *).
HasBuiltins m =>
VerboseKey -> m (Maybe QName)
getNameOfConstrained VerboseKey
builtin_glue
  Maybe QName
mglueU  <- VerboseKey -> TCMT IO (Maybe QName)
forall (m :: * -> *).
HasBuiltins m =>
VerboseKey -> m (Maybe QName)
getNameOfConstrained VerboseKey
builtin_glueU
  case Expr
hd of
    -- Type checking #. The # that the user can write will be a Def, but the
    -- sharp we generate in the body of the wrapper is a Con.
    A.Def QName
c | QName -> Maybe QName
forall a. a -> Maybe a
Just QName
c Maybe QName -> Maybe QName -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe QName
sharp -> Expr -> Type -> QName -> Args -> TCM Term
checkSharpApplication Expr
e Type
t QName
c Args
args

    -- Cubical primitives
    A.Def QName
c | QName -> Maybe QName
forall a. a -> Maybe a
Just QName
c Maybe QName -> Maybe QName -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe QName
pComp -> Maybe (MaybeRanges -> [Arg Term] -> Type -> TCMT IO [Arg Term])
-> TCM Term
defaultResult' (Maybe (MaybeRanges -> [Arg Term] -> Type -> TCMT IO [Arg Term])
 -> TCM Term)
-> Maybe (MaybeRanges -> [Arg Term] -> Type -> TCMT IO [Arg Term])
-> TCM Term
forall a b. (a -> b) -> a -> b
$ (MaybeRanges -> [Arg Term] -> Type -> TCMT IO [Arg Term])
-> Maybe (MaybeRanges -> [Arg Term] -> Type -> TCMT IO [Arg Term])
forall a. a -> Maybe a
Just ((MaybeRanges -> [Arg Term] -> Type -> TCMT IO [Arg Term])
 -> Maybe (MaybeRanges -> [Arg Term] -> Type -> TCMT IO [Arg Term]))
-> (MaybeRanges -> [Arg Term] -> Type -> TCMT IO [Arg Term])
-> Maybe (MaybeRanges -> [Arg Term] -> Type -> TCMT IO [Arg Term])
forall a b. (a -> b) -> a -> b
$ QName -> MaybeRanges -> [Arg Term] -> Type -> TCMT IO [Arg Term]
checkPrimComp QName
c
    A.Def QName
c | QName -> Maybe QName
forall a. a -> Maybe a
Just QName
c Maybe QName -> Maybe QName -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe QName
pHComp -> Maybe (MaybeRanges -> [Arg Term] -> Type -> TCMT IO [Arg Term])
-> TCM Term
defaultResult' (Maybe (MaybeRanges -> [Arg Term] -> Type -> TCMT IO [Arg Term])
 -> TCM Term)
-> Maybe (MaybeRanges -> [Arg Term] -> Type -> TCMT IO [Arg Term])
-> TCM Term
forall a b. (a -> b) -> a -> b
$ (MaybeRanges -> [Arg Term] -> Type -> TCMT IO [Arg Term])
-> Maybe (MaybeRanges -> [Arg Term] -> Type -> TCMT IO [Arg Term])
forall a. a -> Maybe a
Just ((MaybeRanges -> [Arg Term] -> Type -> TCMT IO [Arg Term])
 -> Maybe (MaybeRanges -> [Arg Term] -> Type -> TCMT IO [Arg Term]))
-> (MaybeRanges -> [Arg Term] -> Type -> TCMT IO [Arg Term])
-> Maybe (MaybeRanges -> [Arg Term] -> Type -> TCMT IO [Arg Term])
forall a b. (a -> b) -> a -> b
$ QName -> MaybeRanges -> [Arg Term] -> Type -> TCMT IO [Arg Term]
checkPrimHComp QName
c
    A.Def QName
c | QName -> Maybe QName
forall a. a -> Maybe a
Just QName
c Maybe QName -> Maybe QName -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe QName
pTrans -> Maybe (MaybeRanges -> [Arg Term] -> Type -> TCMT IO [Arg Term])
-> TCM Term
defaultResult' (Maybe (MaybeRanges -> [Arg Term] -> Type -> TCMT IO [Arg Term])
 -> TCM Term)
-> Maybe (MaybeRanges -> [Arg Term] -> Type -> TCMT IO [Arg Term])
-> TCM Term
forall a b. (a -> b) -> a -> b
$ (MaybeRanges -> [Arg Term] -> Type -> TCMT IO [Arg Term])
-> Maybe (MaybeRanges -> [Arg Term] -> Type -> TCMT IO [Arg Term])
forall a. a -> Maybe a
Just ((MaybeRanges -> [Arg Term] -> Type -> TCMT IO [Arg Term])
 -> Maybe (MaybeRanges -> [Arg Term] -> Type -> TCMT IO [Arg Term]))
-> (MaybeRanges -> [Arg Term] -> Type -> TCMT IO [Arg Term])
-> Maybe (MaybeRanges -> [Arg Term] -> Type -> TCMT IO [Arg Term])
forall a b. (a -> b) -> a -> b
$ QName -> MaybeRanges -> [Arg Term] -> Type -> TCMT IO [Arg Term]
checkPrimTrans QName
c
    A.Def QName
c | QName -> Maybe QName
forall a. a -> Maybe a
Just QName
c Maybe QName -> Maybe QName -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe QName
conId -> Maybe (MaybeRanges -> [Arg Term] -> Type -> TCMT IO [Arg Term])
-> TCM Term
defaultResult' (Maybe (MaybeRanges -> [Arg Term] -> Type -> TCMT IO [Arg Term])
 -> TCM Term)
-> Maybe (MaybeRanges -> [Arg Term] -> Type -> TCMT IO [Arg Term])
-> TCM Term
forall a b. (a -> b) -> a -> b
$ (MaybeRanges -> [Arg Term] -> Type -> TCMT IO [Arg Term])
-> Maybe (MaybeRanges -> [Arg Term] -> Type -> TCMT IO [Arg Term])
forall a. a -> Maybe a
Just ((MaybeRanges -> [Arg Term] -> Type -> TCMT IO [Arg Term])
 -> Maybe (MaybeRanges -> [Arg Term] -> Type -> TCMT IO [Arg Term]))
-> (MaybeRanges -> [Arg Term] -> Type -> TCMT IO [Arg Term])
-> Maybe (MaybeRanges -> [Arg Term] -> Type -> TCMT IO [Arg Term])
forall a b. (a -> b) -> a -> b
$ QName -> MaybeRanges -> [Arg Term] -> Type -> TCMT IO [Arg Term]
checkConId QName
c
    A.Def QName
c | QName -> Maybe QName
forall a. a -> Maybe a
Just QName
c Maybe QName -> Maybe QName -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe QName
pOr   -> Maybe (MaybeRanges -> [Arg Term] -> Type -> TCMT IO [Arg Term])
-> TCM Term
defaultResult' (Maybe (MaybeRanges -> [Arg Term] -> Type -> TCMT IO [Arg Term])
 -> TCM Term)
-> Maybe (MaybeRanges -> [Arg Term] -> Type -> TCMT IO [Arg Term])
-> TCM Term
forall a b. (a -> b) -> a -> b
$ (MaybeRanges -> [Arg Term] -> Type -> TCMT IO [Arg Term])
-> Maybe (MaybeRanges -> [Arg Term] -> Type -> TCMT IO [Arg Term])
forall a. a -> Maybe a
Just ((MaybeRanges -> [Arg Term] -> Type -> TCMT IO [Arg Term])
 -> Maybe (MaybeRanges -> [Arg Term] -> Type -> TCMT IO [Arg Term]))
-> (MaybeRanges -> [Arg Term] -> Type -> TCMT IO [Arg Term])
-> Maybe (MaybeRanges -> [Arg Term] -> Type -> TCMT IO [Arg Term])
forall a b. (a -> b) -> a -> b
$ QName -> MaybeRanges -> [Arg Term] -> Type -> TCMT IO [Arg Term]
checkPOr QName
c
    A.Def QName
c | QName -> Maybe QName
forall a. a -> Maybe a
Just QName
c Maybe QName -> Maybe QName -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe QName
mglue -> Maybe (MaybeRanges -> [Arg Term] -> Type -> TCMT IO [Arg Term])
-> TCM Term
defaultResult' (Maybe (MaybeRanges -> [Arg Term] -> Type -> TCMT IO [Arg Term])
 -> TCM Term)
-> Maybe (MaybeRanges -> [Arg Term] -> Type -> TCMT IO [Arg Term])
-> TCM Term
forall a b. (a -> b) -> a -> b
$ (MaybeRanges -> [Arg Term] -> Type -> TCMT IO [Arg Term])
-> Maybe (MaybeRanges -> [Arg Term] -> Type -> TCMT IO [Arg Term])
forall a. a -> Maybe a
Just ((MaybeRanges -> [Arg Term] -> Type -> TCMT IO [Arg Term])
 -> Maybe (MaybeRanges -> [Arg Term] -> Type -> TCMT IO [Arg Term]))
-> (MaybeRanges -> [Arg Term] -> Type -> TCMT IO [Arg Term])
-> Maybe (MaybeRanges -> [Arg Term] -> Type -> TCMT IO [Arg Term])
forall a b. (a -> b) -> a -> b
$ QName -> MaybeRanges -> [Arg Term] -> Type -> TCMT IO [Arg Term]
check_glue QName
c
    A.Def QName
c | QName -> Maybe QName
forall a. a -> Maybe a
Just QName
c Maybe QName -> Maybe QName -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe QName
mglueU -> Maybe (MaybeRanges -> [Arg Term] -> Type -> TCMT IO [Arg Term])
-> TCM Term
defaultResult' (Maybe (MaybeRanges -> [Arg Term] -> Type -> TCMT IO [Arg Term])
 -> TCM Term)
-> Maybe (MaybeRanges -> [Arg Term] -> Type -> TCMT IO [Arg Term])
-> TCM Term
forall a b. (a -> b) -> a -> b
$ (MaybeRanges -> [Arg Term] -> Type -> TCMT IO [Arg Term])
-> Maybe (MaybeRanges -> [Arg Term] -> Type -> TCMT IO [Arg Term])
forall a. a -> Maybe a
Just ((MaybeRanges -> [Arg Term] -> Type -> TCMT IO [Arg Term])
 -> Maybe (MaybeRanges -> [Arg Term] -> Type -> TCMT IO [Arg Term]))
-> (MaybeRanges -> [Arg Term] -> Type -> TCMT IO [Arg Term])
-> Maybe (MaybeRanges -> [Arg Term] -> Type -> TCMT IO [Arg Term])
forall a b. (a -> b) -> a -> b
$ QName -> MaybeRanges -> [Arg Term] -> Type -> TCMT IO [Arg Term]
check_glueU QName
c

    Expr
_ -> TCM Term
defaultResult
  where
  defaultResult :: TCM Term
  defaultResult :: TCM Term
defaultResult = Maybe (MaybeRanges -> [Arg Term] -> Type -> TCMT IO [Arg Term])
-> TCM Term
defaultResult' Maybe (MaybeRanges -> [Arg Term] -> Type -> TCMT IO [Arg Term])
forall a. Maybe a
Nothing
  defaultResult' :: Maybe (MaybeRanges -> Args -> Type -> TCM Args) -> TCM Term
  defaultResult' :: Maybe (MaybeRanges -> [Arg Term] -> Type -> TCMT IO [Arg Term])
-> TCM Term
defaultResult' Maybe (MaybeRanges -> [Arg Term] -> Type -> TCMT IO [Arg Term])
mk = do
    ([Elim' Term] -> Term
f, Type
t0) <- Expr -> TCM ([Elim' Term] -> Term, Type)
inferHead Expr
hd
    ExpandHidden
expandLast <- (TCEnv -> ExpandHidden) -> TCMT IO ExpandHidden
forall (m :: * -> *) a. MonadTCEnv m => (TCEnv -> a) -> m a
asksTC TCEnv -> ExpandHidden
envExpandLast
    ExpandHidden
-> Range
-> Args
-> Type
-> Type
-> (MaybeRanges
    -> [Elim' Term] -> Type -> CheckedTarget -> TCM Term)
-> TCM Term
checkArguments ExpandHidden
expandLast (Expr -> Range
forall t. HasRange t => t -> Range
getRange Expr
hd) Args
args Type
t0 Type
t ((MaybeRanges -> [Elim' Term] -> Type -> CheckedTarget -> TCM Term)
 -> TCM Term)
-> (MaybeRanges
    -> [Elim' Term] -> Type -> CheckedTarget -> TCM Term)
-> TCM Term
forall a b. (a -> b) -> a -> b
$ \ MaybeRanges
rs [Elim' Term]
vs Type
t1 CheckedTarget
checkedTarget -> do
      let check :: Maybe (TCMT IO [Arg Term])
check = do
           MaybeRanges -> [Arg Term] -> Type -> TCMT IO [Arg Term]
k <- Maybe (MaybeRanges -> [Arg Term] -> Type -> TCMT IO [Arg Term])
mk
           [Arg Term]
as <- [Elim' Term] -> Maybe [Arg Term]
forall a. [Elim' a] -> Maybe [Arg a]
allApplyElims [Elim' Term]
vs
           TCMT IO [Arg Term] -> Maybe (TCMT IO [Arg Term])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TCMT IO [Arg Term] -> Maybe (TCMT IO [Arg Term]))
-> TCMT IO [Arg Term] -> Maybe (TCMT IO [Arg Term])
forall a b. (a -> b) -> a -> b
$ MaybeRanges -> [Arg Term] -> Type -> TCMT IO [Arg Term]
k MaybeRanges
rs [Arg Term]
as Type
t1
      [Elim' Term]
vs <- case Maybe (TCMT IO [Arg Term])
check of
              Just TCMT IO [Arg Term]
ck -> do
                (Arg Term -> Elim' Term) -> [Arg Term] -> [Elim' Term]
forall a b. (a -> b) -> [a] -> [b]
map Arg Term -> Elim' Term
forall a. Arg a -> Elim' a
Apply ([Arg Term] -> [Elim' Term])
-> TCMT IO [Arg Term] -> TCMT IO [Elim' Term]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TCMT IO [Arg Term]
ck
              Maybe (TCMT IO [Arg Term])
Nothing -> do
                [Elim' Term] -> TCMT IO [Elim' Term]
forall (m :: * -> *) a. Monad m => a -> m a
return [Elim' Term]
vs
      Term
v <- Term -> TCM Term
forall (m :: * -> *).
(HasConstInfo m, MonadReduce m) =>
Term -> m Term
unfoldInlined ([Elim' Term] -> Term
f [Elim' Term]
vs)
      Comparison -> CheckedTarget -> Term -> Type -> Type -> TCM Term
coerce' Comparison
cmp CheckedTarget
checkedTarget Term
v Type
t1 Type
t

-- Issue #3019 and #4170: Don't insert trailing implicits when checking arguments to existing
-- metavariables.
turnOffExpandLastIfExistingMeta :: A.Expr -> TCM a -> TCM a
turnOffExpandLastIfExistingMeta :: Expr -> TCM a -> TCM a
turnOffExpandLastIfExistingMeta Expr
hd
  | Bool
isExistingMeta = TCM a -> TCM a
forall a. TCM a -> TCM a
reallyDontExpandLast
  | Bool
otherwise      = TCM a -> TCM a
forall a. a -> a
id
  where
    isExistingMeta :: Bool
isExistingMeta = Maybe MetaId -> Bool
forall a. Maybe a -> Bool
isJust (Maybe MetaId -> Bool) -> Maybe MetaId -> Bool
forall a b. (a -> b) -> a -> b
$ MetaInfo -> Maybe MetaId
A.metaNumber (MetaInfo -> Maybe MetaId) -> Maybe MetaInfo -> Maybe MetaId
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Expr -> Maybe MetaInfo
metaInfo Expr
hd
    metaInfo :: Expr -> Maybe MetaInfo
metaInfo (A.QuestionMark MetaInfo
i InteractionId
_) = MetaInfo -> Maybe MetaInfo
forall a. a -> Maybe a
Just MetaInfo
i
    metaInfo (A.Underscore MetaInfo
i)     = MetaInfo -> Maybe MetaInfo
forall a. a -> Maybe a
Just MetaInfo
i
    metaInfo (A.ScopedExpr ScopeInfo
_ Expr
e)   = Expr -> Maybe MetaInfo
metaInfo Expr
e
    metaInfo Expr
_                    = Maybe MetaInfo
forall a. Maybe a
Nothing

-----------------------------------------------------------------------------
-- * Spines
-----------------------------------------------------------------------------

traceCallE :: Call -> ExceptT e TCM r -> ExceptT e TCM r
traceCallE :: Call -> ExceptT e TCM r -> ExceptT e TCM r
traceCallE Call
call ExceptT e TCM r
m = do
  Either e r
z <- TCM (Either e r) -> ExceptT e TCM (Either e r)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (TCM (Either e r) -> ExceptT e TCM (Either e r))
-> TCM (Either e r) -> ExceptT e TCM (Either e r)
forall a b. (a -> b) -> a -> b
$ Call -> TCM (Either e r) -> TCM (Either e r)
forall (tcm :: * -> *) a.
(MonadTCM tcm, ReadTCState tcm, MonadDebug tcm) =>
Call -> tcm a -> tcm a
traceCall Call
call (TCM (Either e r) -> TCM (Either e r))
-> TCM (Either e r) -> TCM (Either e r)
forall a b. (a -> b) -> a -> b
$ ExceptT e TCM r -> TCM (Either e r)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT ExceptT e TCM r
m
  case Either e r
z of
    Right r
e  -> r -> ExceptT e TCM r
forall (m :: * -> *) a. Monad m => a -> m a
return r
e
    Left e
err -> e -> ExceptT e TCM r
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError e
err

-- | If we've already checked the target type we don't have to call coerce.
coerce' :: Comparison -> CheckedTarget -> Term -> Type -> Type -> TCM Term
coerce' :: Comparison -> CheckedTarget -> Term -> Type -> Type -> TCM Term
coerce' Comparison
cmp CheckedTarget
NotCheckedTarget           Term
v Type
inferred Type
expected = Comparison -> Term -> Type -> Type -> TCM Term
forall (m :: * -> *).
(MonadConversion m, MonadTCM m) =>
Comparison -> Term -> Type -> Type -> m Term
coerce Comparison
cmp Term
v Type
inferred Type
expected
coerce' Comparison
cmp (CheckedTarget Maybe ProblemId
Nothing)    Term
v Type
_        Type
_        = Term -> TCM Term
forall (m :: * -> *) a. Monad m => a -> m a
return Term
v
coerce' Comparison
cmp (CheckedTarget (Just ProblemId
pid)) Term
v Type
_        Type
expected = Type -> Term -> ProblemId -> TCM Term
forall (m :: * -> *).
(MonadMetaSolver m, MonadFresh VerboseLevel m) =>
Type -> Term -> ProblemId -> m Term
blockTermOnProblem Type
expected Term
v ProblemId
pid

-- | Check a list of arguments: @checkArgs args t0 t1@ checks that
--   @t0 = Delta -> t0'@ and @args : Delta@. Inserts hidden arguments to
--   make this happen.  Returns the evaluated arguments @vs@, the remaining
--   type @t0'@ (which should be a subtype of @t1@) and any constraints @cs@
--   that have to be solved for everything to be well-formed.

checkArgumentsE :: ExpandHidden -> Range -> [NamedArg A.Expr] -> Type -> Maybe Type ->
                   ExceptT (MaybeRanges, Elims, [NamedArg A.Expr], Type) TCM (MaybeRanges, Elims, Type, CheckedTarget)
checkArgumentsE :: ExpandHidden
-> Range
-> Args
-> Type
-> Maybe Type
-> ExceptT
     (MaybeRanges, [Elim' Term], Args, Type)
     TCM
     (MaybeRanges, [Elim' Term], Type, CheckedTarget)
checkArgumentsE = CheckedTarget
-> ExpandHidden
-> Range
-> Args
-> Type
-> Maybe Type
-> ExceptT
     (MaybeRanges, [Elim' Term], Args, Type)
     TCM
     (MaybeRanges, [Elim' Term], Type, CheckedTarget)
checkArgumentsE' CheckedTarget
NotCheckedTarget

checkArgumentsE'
  :: CheckedTarget     -- ^ Have we already checked the target?
  -> ExpandHidden      -- ^ Insert trailing hidden arguments?
  -> Range             -- ^ Range of the function.
  -> [NamedArg A.Expr] -- ^ Arguments.
  -> Type              -- ^ Type of the function.
  -> Maybe Type        -- ^ Type of the application.
  -> ExceptT (MaybeRanges, Elims, [NamedArg A.Expr], Type) TCM (MaybeRanges, Elims, Type, CheckedTarget)

-- Case: no arguments, do not insert trailing hidden arguments: We are done.
checkArgumentsE' :: CheckedTarget
-> ExpandHidden
-> Range
-> Args
-> Type
-> Maybe Type
-> ExceptT
     (MaybeRanges, [Elim' Term], Args, Type)
     TCM
     (MaybeRanges, [Elim' Term], Type, CheckedTarget)
checkArgumentsE' CheckedTarget
chk ExpandHidden
exh Range
_ [] Type
t0 Maybe Type
_ | ExpandHidden -> Bool
isDontExpandLast ExpandHidden
exh = (MaybeRanges, [Elim' Term], Type, CheckedTarget)
-> ExceptT
     (MaybeRanges, [Elim' Term], Args, Type)
     TCM
     (MaybeRanges, [Elim' Term], Type, CheckedTarget)
forall (m :: * -> *) a. Monad m => a -> m a
return ([], [], Type
t0, CheckedTarget
chk)

-- Case: no arguments, but need to insert trailing hiddens.
checkArgumentsE' CheckedTarget
chk ExpandHidden
_ExpandLast Range
r [] Type
t0 Maybe Type
mt1 =
    Call
-> ExceptT
     (MaybeRanges, [Elim' Term], Args, Type)
     TCM
     (MaybeRanges, [Elim' Term], Type, CheckedTarget)
-> ExceptT
     (MaybeRanges, [Elim' Term], Args, Type)
     TCM
     (MaybeRanges, [Elim' Term], Type, CheckedTarget)
forall e r. Call -> ExceptT e TCM r -> ExceptT e TCM r
traceCallE (Range -> Args -> Type -> Maybe Type -> Call
CheckArguments Range
r [] Type
t0 Maybe Type
mt1) (ExceptT
   (MaybeRanges, [Elim' Term], Args, Type)
   TCM
   (MaybeRanges, [Elim' Term], Type, CheckedTarget)
 -> ExceptT
      (MaybeRanges, [Elim' Term], Args, Type)
      TCM
      (MaybeRanges, [Elim' Term], Type, CheckedTarget))
-> ExceptT
     (MaybeRanges, [Elim' Term], Args, Type)
     TCM
     (MaybeRanges, [Elim' Term], Type, CheckedTarget)
-> ExceptT
     (MaybeRanges, [Elim' Term], Args, Type)
     TCM
     (MaybeRanges, [Elim' Term], Type, CheckedTarget)
forall a b. (a -> b) -> a -> b
$ TCM (MaybeRanges, [Elim' Term], Type, CheckedTarget)
-> ExceptT
     (MaybeRanges, [Elim' Term], Args, Type)
     TCM
     (MaybeRanges, [Elim' Term], Type, CheckedTarget)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (TCM (MaybeRanges, [Elim' Term], Type, CheckedTarget)
 -> ExceptT
      (MaybeRanges, [Elim' Term], Args, Type)
      TCM
      (MaybeRanges, [Elim' Term], Type, CheckedTarget))
-> TCM (MaybeRanges, [Elim' Term], Type, CheckedTarget)
-> ExceptT
     (MaybeRanges, [Elim' Term], Args, Type)
     TCM
     (MaybeRanges, [Elim' Term], Type, CheckedTarget)
forall a b. (a -> b) -> a -> b
$ do
      Maybe Term
mt1' <- (Type -> TCM Term) -> Maybe Type -> TCM (Maybe Term)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Type -> Term
forall t a. Type'' t a -> a
unEl (Type -> Term) -> (Type -> TCMT IO Type) -> Type -> TCM Term
forall (m :: * -> *) b c a.
Functor m =>
(b -> c) -> (a -> m b) -> a -> m c
<.> Type -> TCMT IO Type
forall a (m :: * -> *). (Reduce a, MonadReduce m) => a -> m a
reduce) Maybe Type
mt1
      ([Arg Term]
us, Type
t) <- VerboseLevel -> (Hiding -> Bool) -> Type -> TCM ([Arg Term], Type)
forall (m :: * -> *).
(MonadReduce m, MonadMetaSolver m, MonadDebug m, MonadTCM m) =>
VerboseLevel -> (Hiding -> Bool) -> Type -> m ([Arg Term], Type)
implicitArgs (-VerboseLevel
1) (Maybe Term -> Hiding -> Bool
expand Maybe Term
mt1') Type
t0
      (MaybeRanges, [Elim' Term], Type, CheckedTarget)
-> TCM (MaybeRanges, [Elim' Term], Type, CheckedTarget)
forall (m :: * -> *) a. Monad m => a -> m a
return (VerboseLevel -> Maybe Range -> MaybeRanges
forall a. VerboseLevel -> a -> [a]
replicate ([Arg Term] -> VerboseLevel
forall (t :: * -> *) a. Foldable t => t a -> VerboseLevel
length [Arg Term]
us) Maybe Range
forall a. Maybe a
Nothing, (Arg Term -> Elim' Term) -> [Arg Term] -> [Elim' Term]
forall a b. (a -> b) -> [a] -> [b]
map Arg Term -> Elim' Term
forall a. Arg a -> Elim' a
Apply [Arg Term]
us, Type
t, CheckedTarget
chk)
    where
      expand :: Maybe Term -> Hiding -> Bool
expand (Just (Pi Dom Type
dom Abs Type
_)) Hiding
Hidden     = Bool -> Bool
not (Dom Type -> Bool
forall a. LensHiding a => a -> Bool
hidden Dom Type
dom)
      expand Maybe Term
_                 Hiding
Hidden     = Bool
True
      expand (Just (Pi Dom Type
dom Abs Type
_)) Instance{} = Bool -> Bool
not (Dom Type -> Bool
forall a. LensHiding a => a -> Bool
isInstance Dom Type
dom)
      expand Maybe Term
_                 Instance{} = Bool
True
      expand Maybe Term
_                 Hiding
NotHidden  = Bool
False

-- Case: argument given.
checkArgumentsE' CheckedTarget
chk ExpandHidden
exh Range
r args0 :: Args
args0@(arg :: NamedArg Expr
arg@(Arg ArgInfo
info Named NamedName Expr
e) : Args
args) Type
t0 Maybe Type
mt1 =
    Call
-> ExceptT
     (MaybeRanges, [Elim' Term], Args, Type)
     TCM
     (MaybeRanges, [Elim' Term], Type, CheckedTarget)
-> ExceptT
     (MaybeRanges, [Elim' Term], Args, Type)
     TCM
     (MaybeRanges, [Elim' Term], Type, CheckedTarget)
forall e r. Call -> ExceptT e TCM r -> ExceptT e TCM r
traceCallE (Range -> Args -> Type -> Maybe Type -> Call
CheckArguments Range
r Args
args0 Type
t0 Maybe Type
mt1) (ExceptT
   (MaybeRanges, [Elim' Term], Args, Type)
   TCM
   (MaybeRanges, [Elim' Term], Type, CheckedTarget)
 -> ExceptT
      (MaybeRanges, [Elim' Term], Args, Type)
      TCM
      (MaybeRanges, [Elim' Term], Type, CheckedTarget))
-> ExceptT
     (MaybeRanges, [Elim' Term], Args, Type)
     TCM
     (MaybeRanges, [Elim' Term], Type, CheckedTarget)
-> ExceptT
     (MaybeRanges, [Elim' Term], Args, Type)
     TCM
     (MaybeRanges, [Elim' Term], Type, CheckedTarget)
forall a b. (a -> b) -> a -> b
$ do
      TCMT IO ()
-> ExceptT (MaybeRanges, [Elim' Term], Args, Type) TCM ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (TCMT IO ()
 -> ExceptT (MaybeRanges, [Elim' Term], Args, Type) TCM ())
-> TCMT IO ()
-> ExceptT (MaybeRanges, [Elim' Term], Args, Type) TCM ()
forall a b. (a -> b) -> a -> b
$ VerboseKey -> VerboseLevel -> TCM Doc -> TCMT IO ()
forall (m :: * -> *).
MonadDebug m =>
VerboseKey -> VerboseLevel -> TCM Doc -> m ()
reportSDoc VerboseKey
"tc.term.args" VerboseLevel
30 (TCM Doc -> TCMT IO ()) -> TCM Doc -> TCMT IO ()
forall a b. (a -> b) -> a -> b
$ [TCM Doc] -> TCM Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
sep
        [ TCM Doc
"checkArgumentsE"
--        , "  args0 =" <+> prettyA args0
        , VerboseLevel -> TCM Doc -> TCM Doc
forall (m :: * -> *). Functor m => VerboseLevel -> m Doc -> m Doc
nest VerboseLevel
2 (TCM Doc -> TCM Doc) -> TCM Doc -> TCM Doc
forall a b. (a -> b) -> a -> b
$ [TCM Doc] -> TCM Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
vcat
          [ TCM Doc
"e     =" TCM Doc -> TCM Doc -> TCM Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> Named NamedName Expr -> TCM Doc
forall c a (m :: * -> *).
(Pretty c, ToConcrete a c, MonadAbsToCon m) =>
a -> m Doc
prettyA Named NamedName Expr
e
          , TCM Doc
"t0    =" TCM Doc -> TCM Doc -> TCM Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> Type -> TCM Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM Type
t0
          , TCM Doc
"t1    =" TCM Doc -> TCM Doc -> TCM Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> TCM Doc -> (Type -> TCM Doc) -> Maybe Type -> TCM Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe TCM Doc
"Nothing" Type -> TCM Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM Maybe Type
mt1
          ]
        ]
      -- First, insert implicit arguments, depending on current argument @arg@.
      let hx :: Hiding
hx = ArgInfo -> Hiding
forall a. LensHiding a => a -> Hiding
getHiding ArgInfo
info  -- hiding of current argument
          mx :: Maybe ArgName
          mx :: Maybe VerboseKey
mx = Named NamedName Expr -> Maybe VerboseKey
forall a. LensNamed NamedName a => a -> Maybe VerboseKey
bareNameOf Named NamedName Expr
e    -- name of current argument
          -- do not insert visible arguments
          expand :: Hiding -> VerboseKey -> Bool
expand Hiding
NotHidden VerboseKey
y = Bool
False
          -- insert a hidden argument if arg is not hidden or has different name
          -- insert an instance argument if arg is not instance  or has different name
          expand Hiding
hy        VerboseKey
y = Bool -> Bool
not (Hiding -> Hiding -> Bool
forall a b. (LensHiding a, LensHiding b) => a -> b -> Bool
sameHiding Hiding
hy Hiding
hx) Bool -> Bool -> Bool
|| Bool -> (VerboseKey -> Bool) -> Maybe VerboseKey -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (VerboseKey
y VerboseKey -> VerboseKey -> Bool
forall a. Eq a => a -> a -> Bool
/=) Maybe VerboseKey
mx
      VerboseKey
-> VerboseLevel
-> TCM Doc
-> ExceptT (MaybeRanges, [Elim' Term], Args, Type) TCM ()
forall (m :: * -> *).
MonadDebug m =>
VerboseKey -> VerboseLevel -> TCM Doc -> m ()
reportSDoc VerboseKey
"tc.term.args" VerboseLevel
30 (TCM Doc -> ExceptT (MaybeRanges, [Elim' Term], Args, Type) TCM ())
-> TCM Doc
-> ExceptT (MaybeRanges, [Elim' Term], Args, Type) TCM ()
forall a b. (a -> b) -> a -> b
$ [TCM Doc] -> TCM Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
vcat
        [ TCM Doc
"calling implicitNamedArgs"
        , VerboseLevel -> TCM Doc -> TCM Doc
forall (m :: * -> *). Functor m => VerboseLevel -> m Doc -> m Doc
nest VerboseLevel
2 (TCM Doc -> TCM Doc) -> TCM Doc -> TCM Doc
forall a b. (a -> b) -> a -> b
$ TCM Doc
"t0 = " TCM Doc -> TCM Doc -> TCM Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> Type -> TCM Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM Type
t0
        , VerboseLevel -> TCM Doc -> TCM Doc
forall (m :: * -> *). Functor m => VerboseLevel -> m Doc -> m Doc
nest VerboseLevel
2 (TCM Doc -> TCM Doc) -> TCM Doc -> TCM Doc
forall a b. (a -> b) -> a -> b
$ TCM Doc
"hx = " TCM Doc -> TCM Doc -> TCM Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> VerboseKey -> TCM Doc
forall (m :: * -> *). Monad m => VerboseKey -> m Doc
text (Hiding -> VerboseKey
forall a. Show a => a -> VerboseKey
show Hiding
hx)
        , VerboseLevel -> TCM Doc -> TCM Doc
forall (m :: * -> *). Functor m => VerboseLevel -> m Doc -> m Doc
nest VerboseLevel
2 (TCM Doc -> TCM Doc) -> TCM Doc -> TCM Doc
forall a b. (a -> b) -> a -> b
$ TCM Doc
"mx = " TCM Doc -> TCM Doc -> TCM Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> TCM Doc -> (VerboseKey -> TCM Doc) -> Maybe VerboseKey -> TCM Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe TCM Doc
"nothing" VerboseKey -> TCM Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM Maybe VerboseKey
mx
        ]
      (NamedArgs
nargs, Type
t) <- TCM (NamedArgs, Type)
-> ExceptT
     (MaybeRanges, [Elim' Term], Args, Type) TCM (NamedArgs, Type)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (TCM (NamedArgs, Type)
 -> ExceptT
      (MaybeRanges, [Elim' Term], Args, Type) TCM (NamedArgs, Type))
-> TCM (NamedArgs, Type)
-> ExceptT
     (MaybeRanges, [Elim' Term], Args, Type) TCM (NamedArgs, Type)
forall a b. (a -> b) -> a -> b
$ VerboseLevel
-> (Hiding -> VerboseKey -> Bool) -> Type -> TCM (NamedArgs, Type)
forall (m :: * -> *).
(MonadReduce m, MonadMetaSolver m, MonadDebug m, MonadTCM m) =>
VerboseLevel
-> (Hiding -> VerboseKey -> Bool) -> Type -> m (NamedArgs, Type)
implicitNamedArgs (-VerboseLevel
1) Hiding -> VerboseKey -> Bool
expand Type
t0
      -- Separate names from args.
      let ([Maybe NamedName]
mxs, [Elim' Term]
us) = [(Maybe NamedName, Elim' Term)]
-> ([Maybe NamedName], [Elim' Term])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(Maybe NamedName, Elim' Term)]
 -> ([Maybe NamedName], [Elim' Term]))
-> [(Maybe NamedName, Elim' Term)]
-> ([Maybe NamedName], [Elim' Term])
forall a b. (a -> b) -> a -> b
$ (Arg (Named NamedName Term) -> (Maybe NamedName, Elim' Term))
-> NamedArgs -> [(Maybe NamedName, Elim' Term)]
forall a b. (a -> b) -> [a] -> [b]
map (\ (Arg ArgInfo
ai (Named Maybe NamedName
mx Term
u)) -> (Maybe NamedName
mx, Arg Term -> Elim' Term
forall a. Arg a -> Elim' a
Apply (Arg Term -> Elim' Term) -> Arg Term -> Elim' Term
forall a b. (a -> b) -> a -> b
$ ArgInfo -> Term -> Arg Term
forall e. ArgInfo -> e -> Arg e
Arg ArgInfo
ai Term
u)) NamedArgs
nargs
          xs :: [NamedName]
xs        = [Maybe NamedName] -> [NamedName]
forall a. [Maybe a] -> [a]
catMaybes [Maybe NamedName]
mxs

      -- We need a function type here, but we don't know which kind
      -- (implicit/explicit). But it might be possible to use injectivity to
      -- force a pi.
      Type
t <- TCMT IO Type
-> ExceptT (MaybeRanges, [Elim' Term], Args, Type) TCM Type
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (TCMT IO Type
 -> ExceptT (MaybeRanges, [Elim' Term], Args, Type) TCM Type)
-> TCMT IO Type
-> ExceptT (MaybeRanges, [Elim' Term], Args, Type) TCM Type
forall a b. (a -> b) -> a -> b
$ Type -> TCMT IO Type
forcePiUsingInjectivity Type
t

      -- We are done inserting implicit args.  Now, try to check @arg@.
      Type
-> (MetaId
    -> Type
    -> ExceptT
         (MaybeRanges, [Elim' Term], Args, Type)
         TCM
         (MaybeRanges, [Elim' Term], Type, CheckedTarget))
-> (NotBlocked
    -> Type
    -> ExceptT
         (MaybeRanges, [Elim' Term], Args, Type)
         TCM
         (MaybeRanges, [Elim' Term], Type, CheckedTarget))
-> ExceptT
     (MaybeRanges, [Elim' Term], Args, Type)
     TCM
     (MaybeRanges, [Elim' Term], Type, CheckedTarget)
forall t (m :: * -> *) a.
(Reduce t, IsMeta t, MonadReduce m, HasBuiltins m) =>
t -> (MetaId -> t -> m a) -> (NotBlocked -> t -> m a) -> m a
ifBlocked Type
t (\ MetaId
m Type
t -> (MaybeRanges, [Elim' Term], Args, Type)
-> ExceptT
     (MaybeRanges, [Elim' Term], Args, Type)
     TCM
     (MaybeRanges, [Elim' Term], Type, CheckedTarget)
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (VerboseLevel -> Maybe Range -> MaybeRanges
forall a. VerboseLevel -> a -> [a]
replicate ([Elim' Term] -> VerboseLevel
forall (t :: * -> *) a. Foldable t => t a -> VerboseLevel
length [Elim' Term]
us) Maybe Range
forall a. Maybe a
Nothing, [Elim' Term]
us, Args
args0, Type
t)) ((NotBlocked
  -> Type
  -> ExceptT
       (MaybeRanges, [Elim' Term], Args, Type)
       TCM
       (MaybeRanges, [Elim' Term], Type, CheckedTarget))
 -> ExceptT
      (MaybeRanges, [Elim' Term], Args, Type)
      TCM
      (MaybeRanges, [Elim' Term], Type, CheckedTarget))
-> (NotBlocked
    -> Type
    -> ExceptT
         (MaybeRanges, [Elim' Term], Args, Type)
         TCM
         (MaybeRanges, [Elim' Term], Type, CheckedTarget))
-> ExceptT
     (MaybeRanges, [Elim' Term], Args, Type)
     TCM
     (MaybeRanges, [Elim' Term], Type, CheckedTarget)
forall a b. (a -> b) -> a -> b
$ \ NotBlocked
_ Type
t0' -> do

        -- What can go wrong?

        -- 1. We ran out of function types.
        let shouldBePi :: ExceptT (MaybeRanges, [Elim' Term], Args, Type) TCM a
shouldBePi
              -- a) It is an explicit argument, but we ran out of function types.
              | ArgInfo -> Bool
forall a. LensHiding a => a -> Bool
visible ArgInfo
info = TCMT IO a -> ExceptT (MaybeRanges, [Elim' Term], Args, Type) TCM a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (TCMT IO a
 -> ExceptT (MaybeRanges, [Elim' Term], Args, Type) TCM a)
-> TCMT IO a
-> ExceptT (MaybeRanges, [Elim' Term], Args, Type) TCM a
forall a b. (a -> b) -> a -> b
$ TypeError -> TCMT IO a
forall (m :: * -> *) a.
(MonadTCEnv m, ReadTCState m, MonadError TCErr m) =>
TypeError -> m a
typeError (TypeError -> TCMT IO a) -> TypeError -> TCMT IO a
forall a b. (a -> b) -> a -> b
$ Type -> TypeError
ShouldBePi Type
t0'
              -- b) It is an implicit argument, and we did not insert any implicits.
              --    Thus, the type was not a function type to start with.
              | [NamedName] -> Bool
forall a. Null a => a -> Bool
null [NamedName]
xs        = TCMT IO a -> ExceptT (MaybeRanges, [Elim' Term], Args, Type) TCM a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (TCMT IO a
 -> ExceptT (MaybeRanges, [Elim' Term], Args, Type) TCM a)
-> TCMT IO a
-> ExceptT (MaybeRanges, [Elim' Term], Args, Type) TCM a
forall a b. (a -> b) -> a -> b
$ TypeError -> TCMT IO a
forall (m :: * -> *) a.
(MonadTCEnv m, ReadTCState m, MonadError TCErr m) =>
TypeError -> m a
typeError (TypeError -> TCMT IO a) -> TypeError -> TCMT IO a
forall a b. (a -> b) -> a -> b
$ Type -> TypeError
ShouldBePi Type
t0'
              -- c) We did insert implicits, but we ran out of implicit function types.
              --    Then, we should inform the user that we did not find his one.
              | Bool
otherwise      = TCMT IO a -> ExceptT (MaybeRanges, [Elim' Term], Args, Type) TCM a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (TCMT IO a
 -> ExceptT (MaybeRanges, [Elim' Term], Args, Type) TCM a)
-> TCMT IO a
-> ExceptT (MaybeRanges, [Elim' Term], Args, Type) TCM a
forall a b. (a -> b) -> a -> b
$ TypeError -> TCMT IO a
forall (m :: * -> *) a.
(MonadTCEnv m, ReadTCState m, MonadError TCErr m) =>
TypeError -> m a
typeError (TypeError -> TCMT IO a) -> TypeError -> TCMT IO a
forall a b. (a -> b) -> a -> b
$ NamedArg Expr -> [NamedName] -> TypeError
WrongNamedArgument NamedArg Expr
arg [NamedName]
xs

        -- 2. We have a function type left, but it is the wrong one.
        --    Our argument must be implicit, case a) is impossible.
        --    (Otherwise we would have ran out of function types instead.)
        let wrongPi :: ExceptT (MaybeRanges, [Elim' Term], Args, Type) TCM a
wrongPi
              -- b) We have not inserted any implicits.
              | [NamedName] -> Bool
forall a. Null a => a -> Bool
null [NamedName]
xs   = TCMT IO a -> ExceptT (MaybeRanges, [Elim' Term], Args, Type) TCM a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (TCMT IO a
 -> ExceptT (MaybeRanges, [Elim' Term], Args, Type) TCM a)
-> TCMT IO a
-> ExceptT (MaybeRanges, [Elim' Term], Args, Type) TCM a
forall a b. (a -> b) -> a -> b
$ TypeError -> TCMT IO a
forall (m :: * -> *) a.
(MonadTCEnv m, ReadTCState m, MonadError TCErr m) =>
TypeError -> m a
typeError (TypeError -> TCMT IO a) -> TypeError -> TCMT IO a
forall a b. (a -> b) -> a -> b
$ Type -> TypeError
WrongHidingInApplication Type
t0'
              -- c) We inserted implicits, but did not find his one.
              | Bool
otherwise = TCMT IO a -> ExceptT (MaybeRanges, [Elim' Term], Args, Type) TCM a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (TCMT IO a
 -> ExceptT (MaybeRanges, [Elim' Term], Args, Type) TCM a)
-> TCMT IO a
-> ExceptT (MaybeRanges, [Elim' Term], Args, Type) TCM a
forall a b. (a -> b) -> a -> b
$ TypeError -> TCMT IO a
forall (m :: * -> *) a.
(MonadTCEnv m, ReadTCState m, MonadError TCErr m) =>
TypeError -> m a
typeError (TypeError -> TCMT IO a) -> TypeError -> TCMT IO a
forall a b. (a -> b) -> a -> b
$ NamedArg Expr -> [NamedName] -> TypeError
WrongNamedArgument NamedArg Expr
arg [NamedName]
xs

        Type -> PathView
viewPath <- TCMT IO (Type -> PathView)
-> ExceptT
     (MaybeRanges, [Elim' Term], Args, Type) TCM (Type -> PathView)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift TCMT IO (Type -> PathView)
forall (m :: * -> *). HasBuiltins m => m (Type -> PathView)
pathView'

        -- Check the target type if we can get away with it.
        CheckedTarget
chk' <- TCMT IO CheckedTarget
-> ExceptT
     (MaybeRanges, [Elim' Term], Args, Type) TCM CheckedTarget
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (TCMT IO CheckedTarget
 -> ExceptT
      (MaybeRanges, [Elim' Term], Args, Type) TCM CheckedTarget)
-> TCMT IO CheckedTarget
-> ExceptT
     (MaybeRanges, [Elim' Term], Args, Type) TCM CheckedTarget
forall a b. (a -> b) -> a -> b
$
          case (CheckedTarget
chk, Maybe Type
mt1) of
            (CheckedTarget
NotCheckedTarget, Just Type
t1) | (NamedArg Expr -> Bool) -> Args -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all NamedArg Expr -> Bool
forall a. LensHiding a => a -> Bool
visible Args
args0 -> do
              let n :: VerboseLevel
n = Args -> VerboseLevel
forall (t :: * -> *) a. Foldable t => t a -> VerboseLevel
length Args
args0
              TelV Tele (Dom Type)
tel Type
tgt <- VerboseLevel -> Type -> TCMT IO (TelV Type)
forall (m :: * -> *).
(MonadReduce m, MonadAddContext m) =>
VerboseLevel -> Type -> m (TelV Type)
telViewUpTo VerboseLevel
n Type
t0'
              let dep :: Bool
dep = (VerboseLevel -> Bool) -> [VerboseLevel] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (VerboseLevel -> VerboseLevel -> Bool
forall a. Ord a => a -> a -> Bool
< VerboseLevel
n) ([VerboseLevel] -> Bool) -> [VerboseLevel] -> Bool
forall a b. (a -> b) -> a -> b
$ IntSet -> [VerboseLevel]
IntSet.toList (IntSet -> [VerboseLevel]) -> IntSet -> [VerboseLevel]
forall a b. (a -> b) -> a -> b
$ Type -> IntSet
forall a c t.
(IsVarSet a c, Singleton VerboseLevel c, Free t) =>
t -> c
freeVars Type
tgt
                  vis :: Bool
vis = (Dom (VerboseKey, Type) -> Bool)
-> [Dom (VerboseKey, Type)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Dom (VerboseKey, Type) -> Bool
forall a. LensHiding a => a -> Bool
visible (Tele (Dom Type) -> [Dom (VerboseKey, Type)]
forall t. Tele (Dom t) -> [Dom (VerboseKey, t)]
telToList Tele (Dom Type)
tel)
                  isRigid :: Type -> m Bool
isRigid Type
t | PathType{} <- Type -> PathView
viewPath Type
t = Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False -- Path is not rigid!
                  isRigid (El Sort' Term
_ (Pi Dom Type
dom Abs Type
_)) = Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> m Bool) -> Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ Dom Type -> Bool
forall a. LensHiding a => a -> Bool
visible Dom Type
dom
                  isRigid (El Sort' Term
_ (Def QName
d [Elim' Term]
_))  = Definition -> Defn
theDef (Definition -> Defn) -> m Definition -> m Defn
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> QName -> m Definition
forall (m :: * -> *). HasConstInfo m => QName -> m Definition
getConstInfo QName
d m Defn -> (Defn -> m Bool) -> m Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> m Bool) -> (Defn -> Bool) -> Defn -> m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \ case
                    Axiom{}                   -> Bool
True
                    DataOrRecSig{}            -> Bool
True
                    AbstractDefn{}            -> Bool
True
                    Function{funClauses :: Defn -> [Clause]
funClauses = [Clause]
cs} -> [Clause] -> Bool
forall a. Null a => a -> Bool
null [Clause]
cs
                    Datatype{}                -> Bool
True
                    Record{}                  -> Bool
True
                    Constructor{}             -> Bool
forall a. HasCallStack => a
__IMPOSSIBLE__
                    GeneralizableVar{}        -> Bool
forall a. HasCallStack => a
__IMPOSSIBLE__
                    Primitive{}               -> Bool
False
                  isRigid Type
_           = Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
              Bool
rigid <- Type -> TCM Bool
forall (m :: * -> *). HasConstInfo m => Type -> m Bool
isRigid Type
tgt
              -- Andreas, 2019-03-28, issue #3248:
              -- If the target type is SIZELT, we need coerce, leqType is insufficient.
              -- For example, we have i : Size <= (Size< ↑ i), but not Size <= (Size< ↑ i).
              Bool
isSizeLt <- Type -> TCMT IO Type
forall a (m :: * -> *). (Reduce a, MonadReduce m) => a -> m a
reduce Type
t1 TCMT IO Type
-> (Type -> TCMT IO (Maybe BoundedSize))
-> TCMT IO (Maybe BoundedSize)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Type -> TCMT IO (Maybe BoundedSize)
forall a (m :: * -> *).
(IsSizeType a, HasOptions m, HasBuiltins m) =>
a -> m (Maybe BoundedSize)
isSizeType TCMT IO (Maybe BoundedSize)
-> (Maybe BoundedSize -> Bool) -> TCM Bool
forall (m :: * -> *) a b. Functor m => m a -> (a -> b) -> m b
<&> \case
                Just (BoundedLt Term
_) -> Bool
True
                Maybe BoundedSize
_ -> Bool
False
              if | Bool
dep       -> CheckedTarget -> TCMT IO CheckedTarget
forall (m :: * -> *) a. Monad m => a -> m a
return CheckedTarget
chk    -- must be non-dependent
                 | Bool -> Bool
not Bool
rigid -> CheckedTarget -> TCMT IO CheckedTarget
forall (m :: * -> *) a. Monad m => a -> m a
return CheckedTarget
chk    -- with a rigid target
                 | Bool -> Bool
not Bool
vis   -> CheckedTarget -> TCMT IO CheckedTarget
forall (m :: * -> *) a. Monad m => a -> m a
return CheckedTarget
chk    -- and only visible arguments
                 | Bool
isSizeLt  -> CheckedTarget -> TCMT IO CheckedTarget
forall (m :: * -> *) a. Monad m => a -> m a
return CheckedTarget
chk    -- Issue #3248, not Size<
                 | Bool
otherwise -> do
                  let tgt1 :: Type
tgt1 = Substitution' Term -> Type -> Type
forall t a. Subst t a => Substitution' t -> a -> a
applySubst (Empty -> VerboseLevel -> Substitution' Term
forall a. Empty -> VerboseLevel -> Substitution' a
strengthenS Empty
forall a. HasCallStack => a
__IMPOSSIBLE__ (VerboseLevel -> Substitution' Term)
-> VerboseLevel -> Substitution' Term
forall a b. (a -> b) -> a -> b
$ Tele (Dom Type) -> VerboseLevel
forall a. Sized a => a -> VerboseLevel
size Tele (Dom Type)
tel) Type
tgt
                  VerboseKey -> VerboseLevel -> TCM Doc -> TCMT IO ()
forall (m :: * -> *).
MonadDebug m =>
VerboseKey -> VerboseLevel -> TCM Doc -> m ()
reportSDoc VerboseKey
"tc.term.args.target" VerboseLevel
30 (TCM Doc -> TCMT IO ()) -> TCM Doc -> TCMT IO ()
forall a b. (a -> b) -> a -> b
$ [TCM Doc] -> TCM Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
vcat
                    [ TCM Doc
"Checking target types first"
                    , VerboseLevel -> TCM Doc -> TCM Doc
forall (m :: * -> *). Functor m => VerboseLevel -> m Doc -> m Doc
nest VerboseLevel
2 (TCM Doc -> TCM Doc) -> TCM Doc -> TCM Doc
forall a b. (a -> b) -> a -> b
$ TCM Doc
"inferred =" TCM Doc -> TCM Doc -> TCM Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> Type -> TCM Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM Type
tgt1
                    , VerboseLevel -> TCM Doc -> TCM Doc
forall (m :: * -> *). Functor m => VerboseLevel -> m Doc -> m Doc
nest VerboseLevel
2 (TCM Doc -> TCM Doc) -> TCM Doc -> TCM Doc
forall a b. (a -> b) -> a -> b
$ TCM Doc
"expected =" TCM Doc -> TCM Doc -> TCM Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> Type -> TCM Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM Type
t1 ]
                  Call -> TCMT IO CheckedTarget -> TCMT IO CheckedTarget
forall (tcm :: * -> *) a.
(MonadTCM tcm, ReadTCState tcm, MonadDebug tcm) =>
Call -> tcm a -> tcm a
traceCall (Range -> Type -> Type -> Call
CheckTargetType (Range -> Args -> Range
forall u t. (HasRange u, HasRange t) => u -> t -> Range
fuseRange Range
r Args
args0) Type
tgt1 Type
t1) (TCMT IO CheckedTarget -> TCMT IO CheckedTarget)
-> TCMT IO CheckedTarget -> TCMT IO CheckedTarget
forall a b. (a -> b) -> a -> b
$
                    Maybe ProblemId -> CheckedTarget
CheckedTarget (Maybe ProblemId -> CheckedTarget)
-> TCMT IO (Maybe ProblemId) -> TCMT IO CheckedTarget
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TCMT IO ()
-> TCMT IO (Maybe ProblemId)
-> (ProblemId -> TCMT IO (Maybe ProblemId))
-> TCMT IO (Maybe ProblemId)
forall a. TCMT IO () -> TCM a -> (ProblemId -> TCM a) -> TCM a
ifNoConstraints_ (Type -> Type -> TCMT IO ()
forall (m :: * -> *). MonadConversion m => Type -> Type -> m ()
leqType Type
tgt1 Type
t1)
                                        (Maybe ProblemId -> TCMT IO (Maybe ProblemId)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ProblemId
forall a. Maybe a
Nothing) (Maybe ProblemId -> TCMT IO (Maybe ProblemId)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ProblemId -> TCMT IO (Maybe ProblemId))
-> (ProblemId -> Maybe ProblemId)
-> ProblemId
-> TCMT IO (Maybe ProblemId)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProblemId -> Maybe ProblemId
forall a. a -> Maybe a
Just)

            (CheckedTarget, Maybe Type)
_ -> CheckedTarget -> TCMT IO CheckedTarget
forall (m :: * -> *) a. Monad m => a -> m a
return CheckedTarget
chk

        -- t0' <- lift $ forcePi (getHiding info) (maybe "_" rangedThing $ nameOf e) t0'
        case Type -> Term
forall t a. Type'' t a -> a
unEl Type
t0' of
          Pi (Dom{domInfo :: forall t e. Dom' t e -> ArgInfo
domInfo = ArgInfo
info', domName :: forall t e. Dom' t e -> Maybe NamedName
domName = Maybe NamedName
dname, unDom :: forall t e. Dom' t e -> e
unDom = Type
a}) Abs Type
b
            | let name :: VerboseKey
name = VerboseKey -> Maybe NamedName -> VerboseKey
forall a. LensNamed NamedName a => VerboseKey -> a -> VerboseKey
bareNameWithDefault VerboseKey
"_" Maybe NamedName
dname,
              ArgInfo -> ArgInfo -> Bool
forall a b. (LensHiding a, LensHiding b) => a -> b -> Bool
sameHiding ArgInfo
info ArgInfo
info'
              Bool -> Bool -> Bool
&& (ArgInfo -> Bool
forall a. LensHiding a => a -> Bool
visible ArgInfo
info Bool -> Bool -> Bool
|| Bool -> (VerboseKey -> Bool) -> Maybe VerboseKey -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (VerboseKey
name VerboseKey -> VerboseKey -> Bool
forall a. Eq a => a -> a -> Bool
==) Maybe VerboseKey
mx) -> do
                Term
u <- TCM Term
-> ExceptT (MaybeRanges, [Elim' Term], Args, Type) TCM Term
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (TCM Term
 -> ExceptT (MaybeRanges, [Elim' Term], Args, Type) TCM Term)
-> TCM Term
-> ExceptT (MaybeRanges, [Elim' Term], Args, Type) TCM Term
forall a b. (a -> b) -> a -> b
$ ArgInfo -> TCM Term -> TCM Term
forall (tcm :: * -> *) m a.
(MonadTCEnv tcm, LensModality m) =>
m -> tcm a -> tcm a
applyModalityToContext ArgInfo
info' (TCM Term -> TCM Term) -> TCM Term -> TCM Term
forall a b. (a -> b) -> a -> b
$ do
                 -- Andreas, 2014-05-30 experiment to check non-dependent arguments
                 -- after the spine has been processed.  Allows to propagate type info
                 -- from ascribed type into extended-lambdas.  Would solve issue 1159.
                 -- However, leaves unsolved type checking problems in the test suite.
                 -- I do not know what I am doing wrong here.
                 -- Could be extreme order-sensitivity or my abuse of the postponing
                 -- mechanism.
                 -- Andreas, 2016-02-02: Ulf says unless there is actually some meta
                 -- blocking a postponed type checking problem, we might never retry,
                 -- since the trigger for retrying constraints is solving a meta.
                 -- Thus, the following naive use violates some invariant.
                 -- if not $ isBinderUsed b
                 -- then postponeTypeCheckingProblem (CheckExpr (namedThing e) a) (return True) else
                  let e' :: Named NamedName Expr
e' = Named NamedName Expr
e { nameOf :: Maybe NamedName
nameOf = Maybe NamedName
-> (NamedName -> Maybe NamedName)
-> Maybe NamedName
-> Maybe NamedName
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Maybe NamedName
dname NamedName -> Maybe NamedName
forall a. a -> Maybe a
Just (Named NamedName Expr -> Maybe NamedName
forall name a. Named name a -> Maybe name
nameOf Named NamedName Expr
e) }
                  NamedArg Expr -> Type -> TCM Term
checkNamedArg (ArgInfo -> Named NamedName Expr -> NamedArg Expr
forall e. ArgInfo -> e -> Arg e
Arg ArgInfo
info' Named NamedName Expr
e') Type
a
                -- save relevance info' from domain in argument
                [Elim' Term]
-> Range
-> Elim' Term
-> ExceptT
     (MaybeRanges, [Elim' Term], Args, Type)
     TCM
     (MaybeRanges, [Elim' Term], Type, CheckedTarget)
-> ExceptT
     (MaybeRanges, [Elim' Term], Args, Type)
     TCM
     (MaybeRanges, [Elim' Term], Type, CheckedTarget)
forall a a c d (m :: * -> *) c d.
MonadError ([Maybe a], [a], c, d) m =>
[a]
-> a -> a -> m ([Maybe a], [a], c, d) -> m ([Maybe a], [a], c, d)
addCheckedArgs [Elim' Term]
us (Named NamedName Expr -> Range
forall t. HasRange t => t -> Range
getRange Named NamedName Expr
e) (Arg Term -> Elim' Term
forall a. Arg a -> Elim' a
Apply (Arg Term -> Elim' Term) -> Arg Term -> Elim' Term
forall a b. (a -> b) -> a -> b
$ ArgInfo -> Term -> Arg Term
forall e. ArgInfo -> e -> Arg e
Arg ArgInfo
info' Term
u) (ExceptT
   (MaybeRanges, [Elim' Term], Args, Type)
   TCM
   (MaybeRanges, [Elim' Term], Type, CheckedTarget)
 -> ExceptT
      (MaybeRanges, [Elim' Term], Args, Type)
      TCM
      (MaybeRanges, [Elim' Term], Type, CheckedTarget))
-> ExceptT
     (MaybeRanges, [Elim' Term], Args, Type)
     TCM
     (MaybeRanges, [Elim' Term], Type, CheckedTarget)
-> ExceptT
     (MaybeRanges, [Elim' Term], Args, Type)
     TCM
     (MaybeRanges, [Elim' Term], Type, CheckedTarget)
forall a b. (a -> b) -> a -> b
$
                  CheckedTarget
-> ExpandHidden
-> Range
-> Args
-> Type
-> Maybe Type
-> ExceptT
     (MaybeRanges, [Elim' Term], Args, Type)
     TCM
     (MaybeRanges, [Elim' Term], Type, CheckedTarget)
checkArgumentsE' CheckedTarget
chk' ExpandHidden
exh (Range -> Named NamedName Expr -> Range
forall u t. (HasRange u, HasRange t) => u -> t -> Range
fuseRange Range
r Named NamedName Expr
e) Args
args (Abs Type -> Term -> Type
forall t a. Subst t a => Abs a -> t -> a
absApp Abs Type
b Term
u) Maybe Type
mt1
            | Bool
otherwise -> do
                VerboseKey
-> VerboseLevel
-> TCM Doc
-> ExceptT (MaybeRanges, [Elim' Term], Args, Type) TCM ()
forall (m :: * -> *).
MonadDebug m =>
VerboseKey -> VerboseLevel -> TCM Doc -> m ()
reportSDoc VerboseKey
"error" VerboseLevel
10 (TCM Doc -> ExceptT (MaybeRanges, [Elim' Term], Args, Type) TCM ())
-> TCM Doc
-> ExceptT (MaybeRanges, [Elim' Term], Args, Type) TCM ()
forall a b. (a -> b) -> a -> b
$ VerboseLevel -> TCM Doc -> TCM Doc
forall (m :: * -> *). Functor m => VerboseLevel -> m Doc -> m Doc
nest VerboseLevel
2 (TCM Doc -> TCM Doc) -> TCM Doc -> TCM Doc
forall a b. (a -> b) -> a -> b
$ [TCM Doc] -> TCM Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
vcat
                  [ VerboseKey -> TCM Doc
forall (m :: * -> *). Monad m => VerboseKey -> m Doc
text (VerboseKey -> TCM Doc) -> VerboseKey -> TCM Doc
forall a b. (a -> b) -> a -> b
$ VerboseKey
"info      = " VerboseKey -> VerboseKey -> VerboseKey
forall a. [a] -> [a] -> [a]
++ ArgInfo -> VerboseKey
forall a. Show a => a -> VerboseKey
show ArgInfo
info
                  , VerboseKey -> TCM Doc
forall (m :: * -> *). Monad m => VerboseKey -> m Doc
text (VerboseKey -> TCM Doc) -> VerboseKey -> TCM Doc
forall a b. (a -> b) -> a -> b
$ VerboseKey
"info'     = " VerboseKey -> VerboseKey -> VerboseKey
forall a. [a] -> [a] -> [a]
++ ArgInfo -> VerboseKey
forall a. Show a => a -> VerboseKey
show ArgInfo
info'
                  , VerboseKey -> TCM Doc
forall (m :: * -> *). Monad m => VerboseKey -> m Doc
text (VerboseKey -> TCM Doc) -> VerboseKey -> TCM Doc
forall a b. (a -> b) -> a -> b
$ VerboseKey
"absName b = " VerboseKey -> VerboseKey -> VerboseKey
forall a. [a] -> [a] -> [a]
++ Abs Type -> VerboseKey
forall a. Abs a -> VerboseKey
absName Abs Type
b
                  , VerboseKey -> TCM Doc
forall (m :: * -> *). Monad m => VerboseKey -> m Doc
text (VerboseKey -> TCM Doc) -> VerboseKey -> TCM Doc
forall a b. (a -> b) -> a -> b
$ VerboseKey
"nameOf e  = " VerboseKey -> VerboseKey -> VerboseKey
forall a. [a] -> [a] -> [a]
++ Maybe NamedName -> VerboseKey
forall a. Show a => a -> VerboseKey
show (Named NamedName Expr -> Maybe NamedName
forall name a. Named name a -> Maybe name
nameOf Named NamedName Expr
e)
                  ]
                ExceptT
  (MaybeRanges, [Elim' Term], Args, Type)
  TCM
  (MaybeRanges, [Elim' Term], Type, CheckedTarget)
forall a. ExceptT (MaybeRanges, [Elim' Term], Args, Type) TCM a
wrongPi
          Term
_
            | ArgInfo -> Bool
forall a. LensHiding a => a -> Bool
visible ArgInfo
info
            , PathType Sort' Term
s QName
_ Arg Term
_ Arg Term
bA Arg Term
x Arg Term
y <- Type -> PathView
viewPath Type
t0' -> do
                TCMT IO ()
-> ExceptT (MaybeRanges, [Elim' Term], Args, Type) TCM ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (TCMT IO ()
 -> ExceptT (MaybeRanges, [Elim' Term], Args, Type) TCM ())
-> TCMT IO ()
-> ExceptT (MaybeRanges, [Elim' Term], Args, Type) TCM ()
forall a b. (a -> b) -> a -> b
$ VerboseKey -> VerboseLevel -> TCM Doc -> TCMT IO ()
forall (m :: * -> *).
MonadDebug m =>
VerboseKey -> VerboseLevel -> TCM Doc -> m ()
reportSDoc VerboseKey
"tc.term.args" VerboseLevel
30 (TCM Doc -> TCMT IO ()) -> TCM Doc -> TCMT IO ()
forall a b. (a -> b) -> a -> b
$ VerboseKey -> TCM Doc
forall (m :: * -> *). Monad m => VerboseKey -> m Doc
text (VerboseKey -> TCM Doc) -> VerboseKey -> TCM Doc
forall a b. (a -> b) -> a -> b
$ Arg Term -> VerboseKey
forall a. Show a => a -> VerboseKey
show Arg Term
bA
                Term
u <- TCM Term
-> ExceptT (MaybeRanges, [Elim' Term], Args, Type) TCM Term
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (TCM Term
 -> ExceptT (MaybeRanges, [Elim' Term], Args, Type) TCM Term)
-> TCM Term
-> ExceptT (MaybeRanges, [Elim' Term], Args, Type) TCM Term
forall a b. (a -> b) -> a -> b
$ Expr -> Type -> TCM Term
checkExpr (Named NamedName Expr -> Expr
forall name a. Named name a -> a
namedThing Named NamedName Expr
e) (Type -> TCM Term) -> TCMT IO Type -> TCM Term
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< TCM Term -> TCMT IO Type
forall (m :: * -> *). Functor m => m Term -> m Type
elInf TCM Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primInterval
                [Elim' Term]
-> Range
-> Elim' Term
-> ExceptT
     (MaybeRanges, [Elim' Term], Args, Type)
     TCM
     (MaybeRanges, [Elim' Term], Type, CheckedTarget)
-> ExceptT
     (MaybeRanges, [Elim' Term], Args, Type)
     TCM
     (MaybeRanges, [Elim' Term], Type, CheckedTarget)
forall a a c d (m :: * -> *) c d.
MonadError ([Maybe a], [a], c, d) m =>
[a]
-> a -> a -> m ([Maybe a], [a], c, d) -> m ([Maybe a], [a], c, d)
addCheckedArgs [Elim' Term]
us (Named NamedName Expr -> Range
forall t. HasRange t => t -> Range
getRange Named NamedName Expr
e) (Term -> Term -> Term -> Elim' Term
forall a. a -> a -> a -> Elim' a
IApply (Arg Term -> Term
forall e. Arg e -> e
unArg Arg Term
x) (Arg Term -> Term
forall e. Arg e -> e
unArg Arg Term
y) Term
u) (ExceptT
   (MaybeRanges, [Elim' Term], Args, Type)
   TCM
   (MaybeRanges, [Elim' Term], Type, CheckedTarget)
 -> ExceptT
      (MaybeRanges, [Elim' Term], Args, Type)
      TCM
      (MaybeRanges, [Elim' Term], Type, CheckedTarget))
-> ExceptT
     (MaybeRanges, [Elim' Term], Args, Type)
     TCM
     (MaybeRanges, [Elim' Term], Type, CheckedTarget)
-> ExceptT
     (MaybeRanges, [Elim' Term], Args, Type)
     TCM
     (MaybeRanges, [Elim' Term], Type, CheckedTarget)
forall a b. (a -> b) -> a -> b
$
                  ExpandHidden
-> Range
-> Args
-> Type
-> Maybe Type
-> ExceptT
     (MaybeRanges, [Elim' Term], Args, Type)
     TCM
     (MaybeRanges, [Elim' Term], Type, CheckedTarget)
checkArgumentsE ExpandHidden
exh (Range -> Named NamedName Expr -> Range
forall u t. (HasRange u, HasRange t) => u -> t -> Range
fuseRange Range
r Named NamedName Expr
e) Args
args (Sort' Term -> Term -> Type
forall t a. Sort' t -> a -> Type'' t a
El Sort' Term
s (Term -> Type) -> Term -> Type
forall a b. (a -> b) -> a -> b
$ Arg Term -> Term
forall e. Arg e -> e
unArg Arg Term
bA Term -> [Arg Term] -> Term
forall t. Apply t => t -> [Arg Term] -> t
`apply` [Term -> Arg Term
forall e. e -> Arg e
argN Term
u]) Maybe Type
mt1
          Term
_ -> ExceptT
  (MaybeRanges, [Elim' Term], Args, Type)
  TCM
  (MaybeRanges, [Elim' Term], Type, CheckedTarget)
forall a. ExceptT (MaybeRanges, [Elim' Term], Args, Type) TCM a
shouldBePi
  where
    addCheckedArgs :: [a]
-> a -> a -> m ([Maybe a], [a], c, d) -> m ([Maybe a], [a], c, d)
addCheckedArgs [a]
us a
r a
u m ([Maybe a], [a], c, d)
rec = do
        ([Maybe a]
rs, [a]
vs, c
t, d
chk) <- m ([Maybe a], [a], c, d)
rec
        let rs' :: [Maybe a]
rs' = VerboseLevel -> Maybe a -> [Maybe a]
forall a. VerboseLevel -> a -> [a]
replicate ([a] -> VerboseLevel
forall (t :: * -> *) a. Foldable t => t a -> VerboseLevel
length [a]
us) Maybe a
forall a. Maybe a
Nothing [Maybe a] -> [Maybe a] -> [Maybe a]
forall a. [a] -> [a] -> [a]
++ a -> Maybe a
forall a. a -> Maybe a
Just a
r Maybe a -> [Maybe a] -> [Maybe a]
forall a. a -> [a] -> [a]
: [Maybe a]
rs
        ([Maybe a], [a], c, d) -> m ([Maybe a], [a], c, d)
forall (m :: * -> *) a. Monad m => a -> m a
return ([Maybe a]
rs', [a]
us [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ a
u a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
vs, c
t, d
chk)
      m ([Maybe a], [a], c, d)
-> (([Maybe a], [a], c, d) -> m ([Maybe a], [a], c, d))
-> m ([Maybe a], [a], c, d)
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
`catchError` \ ([Maybe a]
rs, [a]
vs, c
es, d
t) -> do
          let rs' :: [Maybe a]
rs' = VerboseLevel -> Maybe a -> [Maybe a]
forall a. VerboseLevel -> a -> [a]
replicate ([a] -> VerboseLevel
forall (t :: * -> *) a. Foldable t => t a -> VerboseLevel
length [a]
us) Maybe a
forall a. Maybe a
Nothing [Maybe a] -> [Maybe a] -> [Maybe a]
forall a. [a] -> [a] -> [a]
++ a -> Maybe a
forall a. a -> Maybe a
Just a
r Maybe a -> [Maybe a] -> [Maybe a]
forall a. a -> [a] -> [a]
: [Maybe a]
rs
          ([Maybe a], [a], c, d) -> m ([Maybe a], [a], c, d)
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ([Maybe a]
rs', [a]
us [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ a
u a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
vs, c
es, d
t)

-- | Check that a list of arguments fits a telescope.
--   Inserts hidden arguments as necessary.
--   Returns the type-checked arguments and the remaining telescope.
checkArguments_
  :: ExpandHidden         -- ^ Eagerly insert trailing hidden arguments?
  -> Range                -- ^ Range of application.
  -> [NamedArg A.Expr]    -- ^ Arguments to check.
  -> Telescope            -- ^ Telescope to check arguments against.
  -> TCM (Elims, Telescope)
     -- ^ Checked arguments and remaining telescope if successful.
checkArguments_ :: ExpandHidden
-> Range
-> Args
-> Tele (Dom Type)
-> TCMT IO ([Elim' Term], Tele (Dom Type))
checkArguments_ ExpandHidden
exh Range
r Args
args Tele (Dom Type)
tel = TCMT IO ([Elim' Term], Tele (Dom Type))
-> TCMT IO ([Elim' Term], Tele (Dom Type))
forall a. TCM a -> TCM a
postponeInstanceConstraints (TCMT IO ([Elim' Term], Tele (Dom Type))
 -> TCMT IO ([Elim' Term], Tele (Dom Type)))
-> TCMT IO ([Elim' Term], Tele (Dom Type))
-> TCMT IO ([Elim' Term], Tele (Dom Type))
forall a b. (a -> b) -> a -> b
$ do
    Either
  (MaybeRanges, [Elim' Term], Args, Type)
  (MaybeRanges, [Elim' Term], Type, CheckedTarget)
z <- ExceptT
  (MaybeRanges, [Elim' Term], Args, Type)
  TCM
  (MaybeRanges, [Elim' Term], Type, CheckedTarget)
-> TCM
     (Either
        (MaybeRanges, [Elim' Term], Args, Type)
        (MaybeRanges, [Elim' Term], Type, CheckedTarget))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT
   (MaybeRanges, [Elim' Term], Args, Type)
   TCM
   (MaybeRanges, [Elim' Term], Type, CheckedTarget)
 -> TCM
      (Either
         (MaybeRanges, [Elim' Term], Args, Type)
         (MaybeRanges, [Elim' Term], Type, CheckedTarget)))
-> ExceptT
     (MaybeRanges, [Elim' Term], Args, Type)
     TCM
     (MaybeRanges, [Elim' Term], Type, CheckedTarget)
-> TCM
     (Either
        (MaybeRanges, [Elim' Term], Args, Type)
        (MaybeRanges, [Elim' Term], Type, CheckedTarget))
forall a b. (a -> b) -> a -> b
$
      ExpandHidden
-> Range
-> Args
-> Type
-> Maybe Type
-> ExceptT
     (MaybeRanges, [Elim' Term], Args, Type)
     TCM
     (MaybeRanges, [Elim' Term], Type, CheckedTarget)
checkArgumentsE ExpandHidden
exh Range
r Args
args (Tele (Dom Type) -> Type -> Type
telePi Tele (Dom Type)
tel Type
HasCallStack => Type
__DUMMY_TYPE__) Maybe Type
forall a. Maybe a
Nothing
    case Either
  (MaybeRanges, [Elim' Term], Args, Type)
  (MaybeRanges, [Elim' Term], Type, CheckedTarget)
z of
      Right (MaybeRanges
_, [Elim' Term]
args, Type
t, CheckedTarget
_) -> do
        let TelV Tele (Dom Type)
tel' Type
_ = Type -> TelV Type
telView' Type
t
        ([Elim' Term], Tele (Dom Type))
-> TCMT IO ([Elim' Term], Tele (Dom Type))
forall (m :: * -> *) a. Monad m => a -> m a
return ([Elim' Term]
args, Tele (Dom Type)
tel')
      Left (MaybeRanges, [Elim' Term], Args, Type)
_ -> TCMT IO ([Elim' Term], Tele (Dom Type))
forall a. HasCallStack => a
__IMPOSSIBLE__  -- type cannot be blocked as it is generated by telePi

-- | @checkArguments exph r args t0 t k@ tries @checkArgumentsE exph args t0 t@.
-- If it succeeds, it continues @k@ with the returned results.  If it fails,
-- it registers a postponed typechecking problem and returns the resulting new
-- meta variable.
--
-- Checks @e := ((_ : t0) args) : t@.
checkArguments ::
  ExpandHidden -> Range -> [NamedArg A.Expr] -> Type -> Type ->
  (MaybeRanges -> Elims -> Type -> CheckedTarget -> TCM Term) -> TCM Term
checkArguments :: ExpandHidden
-> Range
-> Args
-> Type
-> Type
-> (MaybeRanges
    -> [Elim' Term] -> Type -> CheckedTarget -> TCM Term)
-> TCM Term
checkArguments ExpandHidden
exph Range
r Args
args Type
t0 Type
t MaybeRanges -> [Elim' Term] -> Type -> CheckedTarget -> TCM Term
k = TCM Term -> TCM Term
forall a. TCM a -> TCM a
postponeInstanceConstraints (TCM Term -> TCM Term) -> TCM Term -> TCM Term
forall a b. (a -> b) -> a -> b
$ do
  Either
  (MaybeRanges, [Elim' Term], Args, Type)
  (MaybeRanges, [Elim' Term], Type, CheckedTarget)
z <- ExceptT
  (MaybeRanges, [Elim' Term], Args, Type)
  TCM
  (MaybeRanges, [Elim' Term], Type, CheckedTarget)
-> TCM
     (Either
        (MaybeRanges, [Elim' Term], Args, Type)
        (MaybeRanges, [Elim' Term], Type, CheckedTarget))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT
   (MaybeRanges, [Elim' Term], Args, Type)
   TCM
   (MaybeRanges, [Elim' Term], Type, CheckedTarget)
 -> TCM
      (Either
         (MaybeRanges, [Elim' Term], Args, Type)
         (MaybeRanges, [Elim' Term], Type, CheckedTarget)))
-> ExceptT
     (MaybeRanges, [Elim' Term], Args, Type)
     TCM
     (MaybeRanges, [Elim' Term], Type, CheckedTarget)
-> TCM
     (Either
        (MaybeRanges, [Elim' Term], Args, Type)
        (MaybeRanges, [Elim' Term], Type, CheckedTarget))
forall a b. (a -> b) -> a -> b
$ ExpandHidden
-> Range
-> Args
-> Type
-> Maybe Type
-> ExceptT
     (MaybeRanges, [Elim' Term], Args, Type)
     TCM
     (MaybeRanges, [Elim' Term], Type, CheckedTarget)
checkArgumentsE ExpandHidden
exph Range
r Args
args Type
t0 (Type -> Maybe Type
forall a. a -> Maybe a
Just Type
t)
  case Either
  (MaybeRanges, [Elim' Term], Args, Type)
  (MaybeRanges, [Elim' Term], Type, CheckedTarget)
z of
    Right (MaybeRanges
rs, [Elim' Term]
vs, Type
t1, CheckedTarget
pid) -> MaybeRanges -> [Elim' Term] -> Type -> CheckedTarget -> TCM Term
k MaybeRanges
rs [Elim' Term]
vs Type
t1 CheckedTarget
pid
      -- vs = evaluated args
      -- t1 = remaining type (needs to be subtype of t)
    Left (MaybeRanges, [Elim' Term], Args, Type)
problem -> (MaybeRanges, [Elim' Term], Args, Type)
-> ExpandHidden
-> Range
-> Args
-> Type
-> (MaybeRanges
    -> [Elim' Term] -> Type -> CheckedTarget -> TCM Term)
-> TCM Term
postponeArgs (MaybeRanges, [Elim' Term], Args, Type)
problem ExpandHidden
exph Range
r Args
args Type
t MaybeRanges -> [Elim' Term] -> Type -> CheckedTarget -> TCM Term
k
      -- if unsuccessful, postpone checking until t0 unblocks

postponeArgs :: (MaybeRanges, Elims, [NamedArg A.Expr], Type) -> ExpandHidden -> Range -> [NamedArg A.Expr] -> Type ->
                (MaybeRanges -> Elims -> Type -> CheckedTarget -> TCM Term) -> TCM Term
postponeArgs :: (MaybeRanges, [Elim' Term], Args, Type)
-> ExpandHidden
-> Range
-> Args
-> Type
-> (MaybeRanges
    -> [Elim' Term] -> Type -> CheckedTarget -> TCM Term)
-> TCM Term
postponeArgs (MaybeRanges
rs, [Elim' Term]
us, Args
es, Type
t0) ExpandHidden
exph Range
r Args
args Type
t MaybeRanges -> [Elim' Term] -> Type -> CheckedTarget -> TCM Term
k = do
  VerboseKey -> VerboseLevel -> TCM Doc -> TCMT IO ()
forall (m :: * -> *).
MonadDebug m =>
VerboseKey -> VerboseLevel -> TCM Doc -> m ()
reportSDoc VerboseKey
"tc.term.expr.args" VerboseLevel
80 (TCM Doc -> TCMT IO ()) -> TCM Doc -> TCMT IO ()
forall a b. (a -> b) -> a -> b
$
    [TCM Doc] -> TCM Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
sep [ TCM Doc
"postponed checking arguments"
        , VerboseLevel -> TCM Doc -> TCM Doc
forall (m :: * -> *). Functor m => VerboseLevel -> m Doc -> m Doc
nest VerboseLevel
4 (TCM Doc -> TCM Doc) -> TCM Doc -> TCM Doc
forall a b. (a -> b) -> a -> b
$ [TCM Doc] -> TCM Doc
forall (m :: * -> *).
(Monad m, Semigroup (m Doc)) =>
[m Doc] -> m Doc
prettyList ((NamedArg Expr -> TCM Doc) -> Args -> [TCM Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Expr -> TCM Doc
forall c a (m :: * -> *).
(Pretty c, ToConcrete a c, MonadAbsToCon m) =>
a -> m Doc
prettyA (Expr -> TCM Doc)
-> (NamedArg Expr -> Expr) -> NamedArg Expr -> TCM Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Named NamedName Expr -> Expr
forall name a. Named name a -> a
namedThing (Named NamedName Expr -> Expr)
-> (NamedArg Expr -> Named NamedName Expr) -> NamedArg Expr -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NamedArg Expr -> Named NamedName Expr
forall e. Arg e -> e
unArg) Args
args)
        , VerboseLevel -> TCM Doc -> TCM Doc
forall (m :: * -> *). Functor m => VerboseLevel -> m Doc -> m Doc
nest VerboseLevel
2 (TCM Doc -> TCM Doc) -> TCM Doc -> TCM Doc
forall a b. (a -> b) -> a -> b
$ TCM Doc
"against"
        , VerboseLevel -> TCM Doc -> TCM Doc
forall (m :: * -> *). Functor m => VerboseLevel -> m Doc -> m Doc
nest VerboseLevel
4 (TCM Doc -> TCM Doc) -> TCM Doc -> TCM Doc
forall a b. (a -> b) -> a -> b
$ Type -> TCM Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM Type
t0 ] TCM Doc -> TCM Doc -> TCM Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
$$
    [TCM Doc] -> TCM Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
sep [ TCM Doc
"progress:"
        , VerboseLevel -> TCM Doc -> TCM Doc
forall (m :: * -> *). Functor m => VerboseLevel -> m Doc -> m Doc
nest VerboseLevel
2 (TCM Doc -> TCM Doc) -> TCM Doc -> TCM Doc
forall a b. (a -> b) -> a -> b
$ TCM Doc
"checked" TCM Doc -> TCM Doc -> TCM Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> [TCM Doc] -> TCM Doc
forall (m :: * -> *).
(Monad m, Semigroup (m Doc)) =>
[m Doc] -> m Doc
prettyList ((Elim' Term -> TCM Doc) -> [Elim' Term] -> [TCM Doc]
forall a b. (a -> b) -> [a] -> [b]
map Elim' Term -> TCM Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM [Elim' Term]
us)
        , VerboseLevel -> TCM Doc -> TCM Doc
forall (m :: * -> *). Functor m => VerboseLevel -> m Doc -> m Doc
nest VerboseLevel
2 (TCM Doc -> TCM Doc) -> TCM Doc -> TCM Doc
forall a b. (a -> b) -> a -> b
$ TCM Doc
"remaining" TCM Doc -> TCM Doc -> TCM Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> [TCM Doc] -> TCM Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
sep [ [TCM Doc] -> TCM Doc
forall (m :: * -> *).
(Monad m, Semigroup (m Doc)) =>
[m Doc] -> m Doc
prettyList ((NamedArg Expr -> TCM Doc) -> Args -> [TCM Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Expr -> TCM Doc
forall c a (m :: * -> *).
(Pretty c, ToConcrete a c, MonadAbsToCon m) =>
a -> m Doc
prettyA (Expr -> TCM Doc)
-> (NamedArg Expr -> Expr) -> NamedArg Expr -> TCM Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Named NamedName Expr -> Expr
forall name a. Named name a -> a
namedThing (Named NamedName Expr -> Expr)
-> (NamedArg Expr -> Named NamedName Expr) -> NamedArg Expr -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NamedArg Expr -> Named NamedName Expr
forall e. Arg e -> e
unArg) Args
es)
                                            , VerboseLevel -> TCM Doc -> TCM Doc
forall (m :: * -> *). Functor m => VerboseLevel -> m Doc -> m Doc
nest VerboseLevel
2 (TCM Doc -> TCM Doc) -> TCM Doc -> TCM Doc
forall a b. (a -> b) -> a -> b
$ TCM Doc
":" TCM Doc -> TCM Doc -> TCM Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> Type -> TCM Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM Type
t0 ] ]
  TypeCheckingProblem -> TCM Term
postponeTypeCheckingProblem_ (ExpandHidden
-> Range
-> Args
-> Type
-> Type
-> (MaybeRanges
    -> [Elim' Term] -> Type -> CheckedTarget -> TCM Term)
-> TypeCheckingProblem
CheckArgs ExpandHidden
exph Range
r Args
es Type
t0 Type
t ((MaybeRanges -> [Elim' Term] -> Type -> CheckedTarget -> TCM Term)
 -> TypeCheckingProblem)
-> (MaybeRanges
    -> [Elim' Term] -> Type -> CheckedTarget -> TCM Term)
-> TypeCheckingProblem
forall a b. (a -> b) -> a -> b
$ \ MaybeRanges
rs' [Elim' Term]
vs Type
t CheckedTarget
pid -> MaybeRanges -> [Elim' Term] -> Type -> CheckedTarget -> TCM Term
k (MaybeRanges
rs MaybeRanges -> MaybeRanges -> MaybeRanges
forall a. [a] -> [a] -> [a]
++ MaybeRanges
rs') ([Elim' Term]
us [Elim' Term] -> [Elim' Term] -> [Elim' Term]
forall a. [a] -> [a] -> [a]
++ [Elim' Term]
vs) Type
t CheckedTarget
pid)

-----------------------------------------------------------------------------
-- * Constructors
-----------------------------------------------------------------------------

-- | Check the type of a constructor application. This is easier than
--   a general application since the implicit arguments can be inserted
--   without looking at the arguments to the constructor.
checkConstructorApplication :: Comparison -> A.Expr -> Type -> ConHead -> [NamedArg A.Expr] -> TCM Term
checkConstructorApplication :: Comparison -> Expr -> Type -> ConHead -> Args -> TCM Term
checkConstructorApplication Comparison
cmp Expr
org Type
t ConHead
c Args
args = do
  VerboseKey -> VerboseLevel -> TCM Doc -> TCMT IO ()
forall (m :: * -> *).
MonadDebug m =>
VerboseKey -> VerboseLevel -> TCM Doc -> m ()
reportSDoc VerboseKey
"tc.term.con" VerboseLevel
50 (TCM Doc -> TCMT IO ()) -> TCM Doc -> TCMT IO ()
forall a b. (a -> b) -> a -> b
$ [TCM Doc] -> TCM Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
vcat
    [ TCM Doc
"entering checkConstructorApplication"
    , VerboseLevel -> TCM Doc -> TCM Doc
forall (m :: * -> *). Functor m => VerboseLevel -> m Doc -> m Doc
nest VerboseLevel
2 (TCM Doc -> TCM Doc) -> TCM Doc -> TCM Doc
forall a b. (a -> b) -> a -> b
$ [TCM Doc] -> TCM Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
vcat
      [ TCM Doc
"org  =" TCM Doc -> TCM Doc -> TCM Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> Expr -> TCM Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM Expr
org
      , TCM Doc
"t    =" TCM Doc -> TCM Doc -> TCM Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> Type -> TCM Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM Type
t
      , TCM Doc
"c    =" TCM Doc -> TCM Doc -> TCM Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> ConHead -> TCM Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM ConHead
c
      , TCM Doc
"args =" TCM Doc -> TCM Doc -> TCM Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> Args -> TCM Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM Args
args
    ] ]
  let paramsGiven :: Bool
paramsGiven = Args -> Bool
checkForParams Args
args
  if Bool
paramsGiven then TCM Term
fallback else do
    VerboseKey -> VerboseLevel -> TCM Doc -> TCMT IO ()
forall (m :: * -> *).
MonadDebug m =>
VerboseKey -> VerboseLevel -> TCM Doc -> m ()
reportSDoc VerboseKey
"tc.term.con" VerboseLevel
50 (TCM Doc -> TCMT IO ()) -> TCM Doc -> TCMT IO ()
forall a b. (a -> b) -> a -> b
$ TCM Doc
"checkConstructorApplication: no parameters explicitly supplied, continuing..."
    Definition
cdef  <- ConHead -> TCMT IO Definition
forall (m :: * -> *). HasConstInfo m => ConHead -> m Definition
getConInfo ConHead
c
    let Constructor{conData :: Defn -> QName
conData = QName
d, conPars :: Defn -> VerboseLevel
conPars = VerboseLevel
npars} = Definition -> Defn
theDef Definition
cdef
    VerboseKey -> VerboseLevel -> TCM Doc -> TCMT IO ()
forall (m :: * -> *).
MonadDebug m =>
VerboseKey -> VerboseLevel -> TCM Doc -> m ()
reportSDoc VerboseKey
"tc.term.con" VerboseLevel
50 (TCM Doc -> TCMT IO ()) -> TCM Doc -> TCMT IO ()
forall a b. (a -> b) -> a -> b
$ VerboseLevel -> TCM Doc -> TCM Doc
forall (m :: * -> *). Functor m => VerboseLevel -> m Doc -> m Doc
nest VerboseLevel
2 (TCM Doc -> TCM Doc) -> TCM Doc -> TCM Doc
forall a b. (a -> b) -> a -> b
$ TCM Doc
"d    =" TCM Doc -> TCM Doc -> TCM Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> QName -> TCM Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM QName
d
    -- Issue 661: t maybe an evaluated form of d .., so we evaluate d
    -- as well and then check wether we deal with the same datatype
    Term
t0 <- Term -> TCM Term
forall a (m :: * -> *). (Reduce a, MonadReduce m) => a -> m a
reduce (QName -> [Elim' Term] -> Term
Def QName
d [])
    Type
tReduced <- Type -> TCMT IO Type
forall a (m :: * -> *). (Reduce a, MonadReduce m) => a -> m a
reduce Type
t
    case (Term
t0, Type -> Term
forall t a. Type'' t a -> a
unEl Type
tReduced) of -- Only fully applied constructors get special treatment
      (Def QName
d0 [Elim' Term]
_, Def QName
d' [Elim' Term]
es) -> do
        let ~(Just [Arg Term]
vs) = [Elim' Term] -> Maybe [Arg Term]
forall a. [Elim' a] -> Maybe [Arg a]
allApplyElims [Elim' Term]
es
        VerboseKey -> VerboseLevel -> TCM Doc -> TCMT IO ()
forall (m :: * -> *).
MonadDebug m =>
VerboseKey -> VerboseLevel -> TCM Doc -> m ()
reportSDoc VerboseKey
"tc.term.con" VerboseLevel
50 (TCM Doc -> TCMT IO ()) -> TCM Doc -> TCMT IO ()
forall a b. (a -> b) -> a -> b
$ VerboseLevel -> TCM Doc -> TCM Doc
forall (m :: * -> *). Functor m => VerboseLevel -> m Doc -> m Doc
nest VerboseLevel
2 (TCM Doc -> TCM Doc) -> TCM Doc -> TCM Doc
forall a b. (a -> b) -> a -> b
$ TCM Doc
"d0   =" TCM Doc -> TCM Doc -> TCM Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> QName -> TCM Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM QName
d0
        VerboseKey -> VerboseLevel -> TCM Doc -> TCMT IO ()
forall (m :: * -> *).
MonadDebug m =>
VerboseKey -> VerboseLevel -> TCM Doc -> m ()
reportSDoc VerboseKey
"tc.term.con" VerboseLevel
50 (TCM Doc -> TCMT IO ()) -> TCM Doc -> TCMT IO ()
forall a b. (a -> b) -> a -> b
$ VerboseLevel -> TCM Doc -> TCM Doc
forall (m :: * -> *). Functor m => VerboseLevel -> m Doc -> m Doc
nest VerboseLevel
2 (TCM Doc -> TCM Doc) -> TCM Doc -> TCM Doc
forall a b. (a -> b) -> a -> b
$ TCM Doc
"d'   =" TCM Doc -> TCM Doc -> TCM Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> QName -> TCM Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM QName
d'
        VerboseKey -> VerboseLevel -> TCM Doc -> TCMT IO ()
forall (m :: * -> *).
MonadDebug m =>
VerboseKey -> VerboseLevel -> TCM Doc -> m ()
reportSDoc VerboseKey
"tc.term.con" VerboseLevel
50 (TCM Doc -> TCMT IO ()) -> TCM Doc -> TCMT IO ()
forall a b. (a -> b) -> a -> b
$ VerboseLevel -> TCM Doc -> TCM Doc
forall (m :: * -> *). Functor m => VerboseLevel -> m Doc -> m Doc
nest VerboseLevel
2 (TCM Doc -> TCM Doc) -> TCM Doc -> TCM Doc
forall a b. (a -> b) -> a -> b
$ TCM Doc
"vs   =" TCM Doc -> TCM Doc -> TCM Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> [Arg Term] -> TCM Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM [Arg Term]
vs
        if QName
d' QName -> QName -> Bool
forall a. Eq a => a -> a -> Bool
/= QName
d0 then TCM Term
fallback else do
         -- Issue 661: d' may take more parameters than d, in particular
         -- these additional parameters could be a module parameter telescope.
         -- Since we get the constructor type ctype from d but the parameters
         -- from t = Def d' vs, we drop the additional parameters.
         Maybe VerboseLevel
npars' <- QName -> TCM (Maybe VerboseLevel)
getNumberOfParameters QName
d'
         Maybe (List2 VerboseLevel)
-> TCM Term -> (List2 VerboseLevel -> TCM Term) -> TCM Term
forall a b. Maybe a -> b -> (a -> b) -> b
caseMaybe (List2 (Maybe VerboseLevel) -> Maybe (List2 VerboseLevel)
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA (List2 (Maybe VerboseLevel) -> Maybe (List2 VerboseLevel))
-> List2 (Maybe VerboseLevel) -> Maybe (List2 VerboseLevel)
forall a b. (a -> b) -> a -> b
$ (Maybe VerboseLevel, Maybe VerboseLevel)
-> List2 (Maybe VerboseLevel)
forall a. (a, a) -> List2 a
List2 (VerboseLevel -> Maybe VerboseLevel
forall a. a -> Maybe a
Just VerboseLevel
npars, Maybe VerboseLevel
npars')) TCM Term
fallback ((List2 VerboseLevel -> TCM Term) -> TCM Term)
-> (List2 VerboseLevel -> TCM Term) -> TCM Term
forall a b. (a -> b) -> a -> b
$ \ (List2 (VerboseLevel
n, VerboseLevel
n')) -> do
           VerboseKey -> VerboseLevel -> TCM Doc -> TCMT IO ()
forall (m :: * -> *).
MonadDebug m =>
VerboseKey -> VerboseLevel -> TCM Doc -> m ()
reportSDoc VerboseKey
"tc.term.con" VerboseLevel
50 (TCM Doc -> TCMT IO ()) -> TCM Doc -> TCMT IO ()
forall a b. (a -> b) -> a -> b
$ VerboseLevel -> TCM Doc -> TCM Doc
forall (m :: * -> *). Functor m => VerboseLevel -> m Doc -> m Doc
nest VerboseLevel
2 (TCM Doc -> TCM Doc) -> TCM Doc -> TCM Doc
forall a b. (a -> b) -> a -> b
$ VerboseKey -> TCM Doc
forall (m :: * -> *). Monad m => VerboseKey -> m Doc
text (VerboseKey -> TCM Doc) -> VerboseKey -> TCM Doc
forall a b. (a -> b) -> a -> b
$ VerboseKey
"n    = " VerboseKey -> VerboseKey -> VerboseKey
forall a. [a] -> [a] -> [a]
++ VerboseLevel -> VerboseKey
forall a. Show a => a -> VerboseKey
show VerboseLevel
n
           VerboseKey -> VerboseLevel -> TCM Doc -> TCMT IO ()
forall (m :: * -> *).
MonadDebug m =>
VerboseKey -> VerboseLevel -> TCM Doc -> m ()
reportSDoc VerboseKey
"tc.term.con" VerboseLevel
50 (TCM Doc -> TCMT IO ()) -> TCM Doc -> TCMT IO ()
forall a b. (a -> b) -> a -> b
$ VerboseLevel -> TCM Doc -> TCM Doc
forall (m :: * -> *). Functor m => VerboseLevel -> m Doc -> m Doc
nest VerboseLevel
2 (TCM Doc -> TCM Doc) -> TCM Doc -> TCM Doc
forall a b. (a -> b) -> a -> b
$ VerboseKey -> TCM Doc
forall (m :: * -> *). Monad m => VerboseKey -> m Doc
text (VerboseKey -> TCM Doc) -> VerboseKey -> TCM Doc
forall a b. (a -> b) -> a -> b
$ VerboseKey
"n'   = " VerboseKey -> VerboseKey -> VerboseKey
forall a. [a] -> [a] -> [a]
++ VerboseLevel -> VerboseKey
forall a. Show a => a -> VerboseKey
show VerboseLevel
n'
           Bool -> TCMT IO () -> TCMT IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (VerboseLevel
n VerboseLevel -> VerboseLevel -> Bool
forall a. Ord a => a -> a -> Bool
> VerboseLevel
n')  -- preprocessor does not like ', so put on next line
             TCMT IO ()
forall a. HasCallStack => a
__IMPOSSIBLE__
           let ps :: [Arg Term]
ps    = VerboseLevel -> [Arg Term] -> [Arg Term]
forall a. VerboseLevel -> [a] -> [a]
take VerboseLevel
n ([Arg Term] -> [Arg Term]) -> [Arg Term] -> [Arg Term]
forall a b. (a -> b) -> a -> b
$ VerboseLevel -> [Arg Term] -> [Arg Term]
forall a. VerboseLevel -> [a] -> [a]
drop (VerboseLevel
n' VerboseLevel -> VerboseLevel -> VerboseLevel
forall a. Num a => a -> a -> a
- VerboseLevel
n) [Arg Term]
vs
               ctype :: Type
ctype = Definition -> Type
defType Definition
cdef
           VerboseKey -> VerboseLevel -> TCM Doc -> TCMT IO ()
forall (m :: * -> *).
MonadDebug m =>
VerboseKey -> VerboseLevel -> TCM Doc -> m ()
reportSDoc VerboseKey
"tc.term.con" VerboseLevel
20 (TCM Doc -> TCMT IO ()) -> TCM Doc -> TCMT IO ()
forall a b. (a -> b) -> a -> b
$ [TCM Doc] -> TCM Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
vcat
             [ TCM Doc
"special checking of constructor application of" TCM Doc -> TCM Doc -> TCM Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> ConHead -> TCM Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM ConHead
c
             , VerboseLevel -> TCM Doc -> TCM Doc
forall (m :: * -> *). Functor m => VerboseLevel -> m Doc -> m Doc
nest VerboseLevel
2 (TCM Doc -> TCM Doc) -> TCM Doc -> TCM Doc
forall a b. (a -> b) -> a -> b
$ [TCM Doc] -> TCM Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
vcat [ TCM Doc
"ps     =" TCM Doc -> TCM Doc -> TCM Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> [Arg Term] -> TCM Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM [Arg Term]
ps
                             , TCM Doc
"ctype  =" TCM Doc -> TCM Doc -> TCM Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> Type -> TCM Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM Type
ctype ] ]
           let ctype' :: Type
ctype' = Type
ctype Type -> [Arg Term] -> Type
`piApply` [Arg Term]
ps
           VerboseKey -> VerboseLevel -> TCM Doc -> TCMT IO ()
forall (m :: * -> *).
MonadDebug m =>
VerboseKey -> VerboseLevel -> TCM Doc -> m ()
reportSDoc VerboseKey
"tc.term.con" VerboseLevel
20 (TCM Doc -> TCMT IO ()) -> TCM Doc -> TCMT IO ()
forall a b. (a -> b) -> a -> b
$ VerboseLevel -> TCM Doc -> TCM Doc
forall (m :: * -> *). Functor m => VerboseLevel -> m Doc -> m Doc
nest VerboseLevel
2 (TCM Doc -> TCM Doc) -> TCM Doc -> TCM Doc
forall a b. (a -> b) -> a -> b
$ TCM Doc
"ctype' =" TCM Doc -> TCM Doc -> TCM Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> Type -> TCM Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM Type
ctype'
           -- get the parameter names
           let TelV Tele (Dom Type)
ptel Type
_ = VerboseLevel -> Type -> TelV Type
telView'UpTo VerboseLevel
n Type
ctype
           let pnames :: [Dom' Term VerboseKey]
pnames = (Dom (VerboseKey, Type) -> Dom' Term VerboseKey)
-> [Dom (VerboseKey, Type)] -> [Dom' Term VerboseKey]
forall a b. (a -> b) -> [a] -> [b]
map (((VerboseKey, Type) -> VerboseKey)
-> Dom (VerboseKey, Type) -> Dom' Term VerboseKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (VerboseKey, Type) -> VerboseKey
forall a b. (a, b) -> a
fst) ([Dom (VerboseKey, Type)] -> [Dom' Term VerboseKey])
-> [Dom (VerboseKey, Type)] -> [Dom' Term VerboseKey]
forall a b. (a -> b) -> a -> b
$ Tele (Dom Type) -> [Dom (VerboseKey, Type)]
forall t. Tele (Dom t) -> [Dom (VerboseKey, t)]
telToList Tele (Dom Type)
ptel
           -- drop the parameter arguments
               args' :: Args
args' = [Dom' Term VerboseKey] -> Args -> Args
forall t. [Dom' t VerboseKey] -> Args -> Args
dropArgs [Dom' Term VerboseKey]
pnames Args
args
           -- check the non-parameter arguments
           ExpandHidden
expandLast <- (TCEnv -> ExpandHidden) -> TCMT IO ExpandHidden
forall (m :: * -> *) a. MonadTCEnv m => (TCEnv -> a) -> m a
asksTC TCEnv -> ExpandHidden
envExpandLast
           ExpandHidden
-> Range
-> Args
-> Type
-> Type
-> (MaybeRanges
    -> [Elim' Term] -> Type -> CheckedTarget -> TCM Term)
-> TCM Term
checkArguments ExpandHidden
expandLast (ConHead -> Range
forall t. HasRange t => t -> Range
getRange ConHead
c) Args
args' Type
ctype' Type
t ((MaybeRanges -> [Elim' Term] -> Type -> CheckedTarget -> TCM Term)
 -> TCM Term)
-> (MaybeRanges
    -> [Elim' Term] -> Type -> CheckedTarget -> TCM Term)
-> TCM Term
forall a b. (a -> b) -> a -> b
$ \ MaybeRanges
rs [Elim' Term]
es Type
t' CheckedTarget
targetCheck -> do
             VerboseKey -> VerboseLevel -> TCM Doc -> TCMT IO ()
forall (m :: * -> *).
MonadDebug m =>
VerboseKey -> VerboseLevel -> TCM Doc -> m ()
reportSDoc VerboseKey
"tc.term.con" VerboseLevel
20 (TCM Doc -> TCMT IO ()) -> TCM Doc -> TCMT IO ()
forall a b. (a -> b) -> a -> b
$ VerboseLevel -> TCM Doc -> TCM Doc
forall (m :: * -> *). Functor m => VerboseLevel -> m Doc -> m Doc
nest VerboseLevel
2 (TCM Doc -> TCM Doc) -> TCM Doc -> TCM Doc
forall a b. (a -> b) -> a -> b
$ [TCM Doc] -> TCM Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
vcat
               [ VerboseKey -> TCM Doc
forall (m :: * -> *). Monad m => VerboseKey -> m Doc
text VerboseKey
"es     =" TCM Doc -> TCM Doc -> TCM Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> [Elim' Term] -> TCM Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM [Elim' Term]
es
               , VerboseKey -> TCM Doc
forall (m :: * -> *). Monad m => VerboseKey -> m Doc
text VerboseKey
"t'     =" TCM Doc -> TCM Doc -> TCM Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> Type -> TCM Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM Type
t' ]
             Comparison -> CheckedTarget -> Term -> Type -> Type -> TCM Term
coerce' Comparison
cmp CheckedTarget
targetCheck (ConHead -> ConInfo -> [Elim' Term] -> Term
Con ConHead
c ConInfo
ConOCon [Elim' Term]
es) Type
t' Type
t
      (Term, Term)
_ -> do
        VerboseKey -> VerboseLevel -> TCM Doc -> TCMT IO ()
forall (m :: * -> *).
MonadDebug m =>
VerboseKey -> VerboseLevel -> TCM Doc -> m ()
reportSDoc VerboseKey
"tc.term.con" VerboseLevel
50 (TCM Doc -> TCMT IO ()) -> TCM Doc -> TCMT IO ()
forall a b. (a -> b) -> a -> b
$ VerboseLevel -> TCM Doc -> TCM Doc
forall (m :: * -> *). Functor m => VerboseLevel -> m Doc -> m Doc
nest VerboseLevel
2 (TCM Doc -> TCM Doc) -> TCM Doc -> TCM Doc
forall a b. (a -> b) -> a -> b
$ TCM Doc
"we are not at a datatype, falling back"
        TCM Term
fallback
  where
    fallback :: TCM Term
fallback = Comparison -> Expr -> Type -> Expr -> Args -> TCM Term
checkHeadApplication Comparison
cmp Expr
org Type
t (AmbiguousQName -> Expr
A.Con (QName -> AmbiguousQName
unambiguous (QName -> AmbiguousQName) -> QName -> AmbiguousQName
forall a b. (a -> b) -> a -> b
$ ConHead -> QName
conName ConHead
c)) Args
args

    -- Check if there are explicitly given hidden arguments,
    -- in which case we fall back to default type checking.
    -- We could work harder, but let's not for now.
    --
    -- Andreas, 2012-04-18: if all inital args are underscores, ignore them
    checkForParams :: Args -> Bool
checkForParams Args
args =
      let (Args
hargs, Args
rest) = (NamedArg Expr -> Bool) -> Args -> (Args, Args)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (Bool -> Bool
not (Bool -> Bool) -> (NamedArg Expr -> Bool) -> NamedArg Expr -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NamedArg Expr -> Bool
forall a. LensHiding a => a -> Bool
visible) Args
args
          notUnderscore :: Expr -> Bool
notUnderscore A.Underscore{} = Bool
False
          notUnderscore Expr
_              = Bool
True
      in  (Expr -> Bool) -> [Expr] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Expr -> Bool
notUnderscore ([Expr] -> Bool) -> [Expr] -> Bool
forall a b. (a -> b) -> a -> b
$ (NamedArg Expr -> Expr) -> Args -> [Expr]
forall a b. (a -> b) -> [a] -> [b]
map (Expr -> Expr
unScope (Expr -> Expr) -> (NamedArg Expr -> Expr) -> NamedArg Expr -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NamedArg Expr -> Expr
forall a. NamedArg a -> a
namedArg) Args
hargs

    -- Drop the constructor arguments that correspond to parameters.
    dropArgs :: [Dom' t VerboseKey] -> Args -> Args
dropArgs [] Args
args                = Args
args
    dropArgs [Dom' t VerboseKey]
ps []                  = Args
args
    dropArgs [Dom' t VerboseKey]
ps args :: Args
args@(NamedArg Expr
arg : Args
args')
      | Just VerboseKey
p   <- Maybe VerboseKey
name,
        Just [Dom' t VerboseKey]
ps' <- VerboseKey -> [Dom' t VerboseKey] -> Maybe [Dom' t VerboseKey]
forall a t. Eq a => a -> [Dom' t a] -> Maybe [Dom' t a]
namedPar VerboseKey
p [Dom' t VerboseKey]
ps   = [Dom' t VerboseKey] -> Args -> Args
dropArgs [Dom' t VerboseKey]
ps' Args
args'
      | Maybe VerboseKey
Nothing  <- Maybe VerboseKey
name,
        Just [Dom' t VerboseKey]
ps' <- Hiding -> [Dom' t VerboseKey] -> Maybe [Dom' t VerboseKey]
forall a b. (LensHiding a, LensHiding b) => a -> [b] -> Maybe [b]
unnamedPar Hiding
h [Dom' t VerboseKey]
ps = [Dom' t VerboseKey] -> Args -> Args
dropArgs [Dom' t VerboseKey]
ps' Args
args'
      | Bool
otherwise                   = Args
args
      where
        name :: Maybe VerboseKey
name = NamedArg Expr -> Maybe VerboseKey
forall a. LensNamed NamedName a => a -> Maybe VerboseKey
bareNameOf NamedArg Expr
arg
        h :: Hiding
h    = NamedArg Expr -> Hiding
forall a. LensHiding a => a -> Hiding
getHiding NamedArg Expr
arg

        namedPar :: a -> [Dom' t a] -> Maybe [Dom' t a]
namedPar   a
x = (Dom' t a -> Bool) -> [Dom' t a] -> Maybe [Dom' t a]
forall t. (t -> Bool) -> [t] -> Maybe [t]
dropPar ((a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
==) (a -> Bool) -> (Dom' t a -> a) -> Dom' t a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dom' t a -> a
forall t e. Dom' t e -> e
unDom)
        unnamedPar :: a -> [b] -> Maybe [b]
unnamedPar a
h = (b -> Bool) -> [b] -> Maybe [b]
forall t. (t -> Bool) -> [t] -> Maybe [t]
dropPar (a -> b -> Bool
forall a b. (LensHiding a, LensHiding b) => a -> b -> Bool
sameHiding a
h)

        dropPar :: (t -> Bool) -> [t] -> Maybe [t]
dropPar t -> Bool
this (t
p : [t]
ps) | t -> Bool
this t
p    = [t] -> Maybe [t]
forall a. a -> Maybe a
Just [t]
ps
                              | Bool
otherwise = (t -> Bool) -> [t] -> Maybe [t]
dropPar t -> Bool
this [t]
ps
        dropPar t -> Bool
_ [] = Maybe [t]
forall a. Maybe a
Nothing

-- | Returns an unblocking action in case of failure.
disambiguateConstructor :: NonEmpty QName -> Type -> TCM (Either (TCM Bool) ConHead)
disambiguateConstructor :: NonEmpty QName -> Type -> TCM (Either (TCM Bool) ConHead)
disambiguateConstructor NonEmpty QName
cs0 Type
t = do
  VerboseKey -> VerboseLevel -> VerboseKey -> TCMT IO ()
forall (m :: * -> *).
MonadDebug m =>
VerboseKey -> VerboseLevel -> VerboseKey -> m ()
reportSLn VerboseKey
"tc.check.term.con" VerboseLevel
40 (VerboseKey -> TCMT IO ()) -> VerboseKey -> TCMT IO ()
forall a b. (a -> b) -> a -> b
$ VerboseKey
"Ambiguous constructor: " VerboseKey -> VerboseKey -> VerboseKey
forall a. [a] -> [a] -> [a]
++ NonEmpty QName -> VerboseKey
forall a. Pretty a => a -> VerboseKey
prettyShow NonEmpty QName
cs0

  -- Get the datatypes of the various constructors
  let getData :: Defn -> QName
getData Constructor{conData :: Defn -> QName
conData = QName
d} = QName
d
      getData Defn
_                        = QName
forall a. HasCallStack => a
__IMPOSSIBLE__
  VerboseKey -> VerboseLevel -> VerboseKey -> TCMT IO ()
forall (m :: * -> *).
MonadDebug m =>
VerboseKey -> VerboseLevel -> VerboseKey -> m ()
reportSLn VerboseKey
"tc.check.term.con" VerboseLevel
40 (VerboseKey -> TCMT IO ()) -> VerboseKey -> TCMT IO ()
forall a b. (a -> b) -> a -> b
$ VerboseKey
"  ranges before: " VerboseKey -> VerboseKey -> VerboseKey
forall a. [a] -> [a] -> [a]
++ Range -> VerboseKey
forall a. Show a => a -> VerboseKey
show (NonEmpty QName -> Range
forall t. HasRange t => t -> Range
getRange NonEmpty QName
cs0)
  -- We use the reduced constructor when disambiguating, but
  -- the original constructor for type checking. This is important
  -- since they may have different types (different parameters).
  -- See issue 279.
  -- Andreas, 2017-08-13, issue #2686: ignore abstract constructors
  ([QName]
cs, [ConHead]
cons)  <- [(QName, ConHead)] -> ([QName], [ConHead])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(QName, ConHead)] -> ([QName], [ConHead]))
-> ([Either SigError (QName, ConHead)] -> [(QName, ConHead)])
-> [Either SigError (QName, ConHead)]
-> ([QName], [ConHead])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([SigError], [(QName, ConHead)]) -> [(QName, ConHead)]
forall a b. (a, b) -> b
snd (([SigError], [(QName, ConHead)]) -> [(QName, ConHead)])
-> ([Either SigError (QName, ConHead)]
    -> ([SigError], [(QName, ConHead)]))
-> [Either SigError (QName, ConHead)]
-> [(QName, ConHead)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Either SigError (QName, ConHead)]
-> ([SigError], [(QName, ConHead)])
forall a b. [Either a b] -> ([a], [b])
partitionEithers ([Either SigError (QName, ConHead)] -> ([QName], [ConHead]))
-> TCMT IO [Either SigError (QName, ConHead)]
-> TCMT IO ([QName], [ConHead])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
     [QName]
-> (QName -> TCMT IO (Either SigError (QName, ConHead)))
-> TCMT IO [Either SigError (QName, ConHead)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (NonEmpty QName -> [QName]
forall a. NonEmpty a -> [a]
NonEmpty.toList NonEmpty QName
cs0) ((QName -> TCMT IO (Either SigError (QName, ConHead)))
 -> TCMT IO [Either SigError (QName, ConHead)])
-> (QName -> TCMT IO (Either SigError (QName, ConHead)))
-> TCMT IO [Either SigError (QName, ConHead)]
forall a b. (a -> b) -> a -> b
$ \ QName
c -> (ConHead -> (QName, ConHead))
-> Either SigError ConHead -> Either SigError (QName, ConHead)
forall b d a. (b -> d) -> Either a b -> Either a d
mapRight (QName
c,) (Either SigError ConHead -> Either SigError (QName, ConHead))
-> TCMT IO (Either SigError ConHead)
-> TCMT IO (Either SigError (QName, ConHead))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> QName -> TCMT IO (Either SigError ConHead)
getConForm QName
c
  VerboseKey -> VerboseLevel -> VerboseKey -> TCMT IO ()
forall (m :: * -> *).
MonadDebug m =>
VerboseKey -> VerboseLevel -> VerboseKey -> m ()
reportSLn VerboseKey
"tc.check.term.con" VerboseLevel
40 (VerboseKey -> TCMT IO ()) -> VerboseKey -> TCMT IO ()
forall a b. (a -> b) -> a -> b
$ VerboseKey
"  reduced: " VerboseKey -> VerboseKey -> VerboseKey
forall a. [a] -> [a] -> [a]
++ [ConHead] -> VerboseKey
forall a. Pretty a => a -> VerboseKey
prettyShow [ConHead]
cons
  case [ConHead]
cons of
    []    -> TypeError -> TCM (Either (TCM Bool) ConHead)
forall (m :: * -> *) a.
(MonadTCEnv m, ReadTCState m, MonadError TCErr m) =>
TypeError -> m a
typeError (TypeError -> TCM (Either (TCM Bool) ConHead))
-> TypeError -> TCM (Either (TCM Bool) ConHead)
forall a b. (a -> b) -> a -> b
$ QName -> TypeError
AbstractConstructorNotInScope (QName -> TypeError) -> QName -> TypeError
forall a b. (a -> b) -> a -> b
$ NonEmpty QName -> QName
forall a. NonEmpty a -> a
NonEmpty.head NonEmpty QName
cs0
    [ConHead
con] -> do
      let c :: ConHead
c = QName -> ConHead -> ConHead
forall a. LensConName a => QName -> a -> a
setConName (QName -> [QName] -> QName
forall a. a -> [a] -> a
headWithDefault QName
forall a. HasCallStack => a
__IMPOSSIBLE__ [QName]
cs) ConHead
con
      VerboseKey -> VerboseLevel -> VerboseKey -> TCMT IO ()
forall (m :: * -> *).
MonadDebug m =>
VerboseKey -> VerboseLevel -> VerboseKey -> m ()
reportSLn VerboseKey
"tc.check.term.con" VerboseLevel
40 (VerboseKey -> TCMT IO ()) -> VerboseKey -> TCMT IO ()
forall a b. (a -> b) -> a -> b
$ VerboseKey
"  only one non-abstract constructor: " VerboseKey -> VerboseKey -> VerboseKey
forall a. [a] -> [a] -> [a]
++ ConHead -> VerboseKey
forall a. Pretty a => a -> VerboseKey
prettyShow ConHead
c
      QName -> TCMT IO ()
storeDisambiguatedName (QName -> TCMT IO ()) -> QName -> TCMT IO ()
forall a b. (a -> b) -> a -> b
$ ConHead -> QName
conName ConHead
c
      Either (TCM Bool) ConHead -> TCM (Either (TCM Bool) ConHead)
forall (m :: * -> *) a. Monad m => a -> m a
return (ConHead -> Either (TCM Bool) ConHead
forall a b. b -> Either a b
Right ConHead
c)
    [ConHead]
_   -> do
      [(QName, ConHead)]
dcs <- (QName -> ConHead -> TCMT IO (QName, ConHead))
-> [QName] -> [ConHead] -> TCMT IO [(QName, ConHead)]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM (\ QName
c ConHead
con -> (, QName -> ConHead -> ConHead
forall a. LensConName a => QName -> a -> a
setConName QName
c ConHead
con) (QName -> (QName, ConHead))
-> (Definition -> QName) -> Definition -> (QName, ConHead)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Defn -> QName
getData (Defn -> QName) -> (Definition -> Defn) -> Definition -> QName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Definition -> Defn
theDef (Definition -> (QName, ConHead))
-> TCMT IO Definition -> TCMT IO (QName, ConHead)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ConHead -> TCMT IO Definition
forall (m :: * -> *). HasConstInfo m => ConHead -> m Definition
getConInfo ConHead
con) [QName]
cs [ConHead]
cons
      -- Type error
      let badCon :: Type -> m a
badCon Type
t = TypeError -> m a
forall (m :: * -> *) a.
(MonadTCEnv m, ReadTCState m, MonadError TCErr m) =>
TypeError -> m a
typeError (TypeError -> m a) -> TypeError -> m a
forall a b. (a -> b) -> a -> b
$ (QName -> Type -> TypeError) -> Type -> QName -> TypeError
forall a b c. (a -> b -> c) -> b -> a -> c
flip QName -> Type -> TypeError
DoesNotConstructAnElementOf Type
t (QName -> TypeError) -> QName -> TypeError
forall a b. (a -> b) -> a -> b
$
            QName -> [QName] -> QName
forall a. a -> [a] -> a
headWithDefault QName
forall a. HasCallStack => a
__IMPOSSIBLE__ [QName]
cs
      -- Lets look at the target type at this point
      let getCon :: TCM (Maybe ConHead)
          getCon :: TCM (Maybe ConHead)
getCon = do
            TelV Tele (Dom Type)
tel Type
t1 <- Type -> TCMT IO (TelV Type)
telViewPath Type
t
            Tele (Dom Type) -> TCM (Maybe ConHead) -> TCM (Maybe ConHead)
forall b (m :: * -> *) a.
(AddContext b, MonadAddContext m) =>
b -> m a -> m a
addContext Tele (Dom Type)
tel (TCM (Maybe ConHead) -> TCM (Maybe ConHead))
-> TCM (Maybe ConHead) -> TCM (Maybe ConHead)
forall a b. (a -> b) -> a -> b
$ do
             VerboseKey -> VerboseLevel -> TCM Doc -> TCMT IO ()
forall (m :: * -> *).
MonadDebug m =>
VerboseKey -> VerboseLevel -> TCM Doc -> m ()
reportSDoc VerboseKey
"tc.check.term.con" VerboseLevel
40 (TCM Doc -> TCMT IO ()) -> TCM Doc -> TCMT IO ()
forall a b. (a -> b) -> a -> b
$ VerboseLevel -> TCM Doc -> TCM Doc
forall (m :: * -> *). Functor m => VerboseLevel -> m Doc -> m Doc
nest VerboseLevel
2 (TCM Doc -> TCM Doc) -> TCM Doc -> TCM Doc
forall a b. (a -> b) -> a -> b
$
               TCM Doc
"target type: " TCM Doc -> TCM Doc -> TCM Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> Type -> TCM Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM Type
t1
             Type
-> (MetaId -> Type -> TCM (Maybe ConHead))
-> (NotBlocked -> Type -> TCM (Maybe ConHead))
-> TCM (Maybe ConHead)
forall t (m :: * -> *) a.
(Reduce t, IsMeta t, MonadReduce m, HasBuiltins m) =>
t -> (MetaId -> t -> m a) -> (NotBlocked -> t -> m a) -> m a
ifBlocked Type
t1 (\ MetaId
m Type
t -> Maybe ConHead -> TCM (Maybe ConHead)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ConHead
forall a. Maybe a
Nothing) ((NotBlocked -> Type -> TCM (Maybe ConHead))
 -> TCM (Maybe ConHead))
-> (NotBlocked -> Type -> TCM (Maybe ConHead))
-> TCM (Maybe ConHead)
forall a b. (a -> b) -> a -> b
$ \ NotBlocked
_ Type
t' ->
               TCMT IO (Maybe QName)
-> TCM (Maybe ConHead)
-> (QName -> TCM (Maybe ConHead))
-> TCM (Maybe ConHead)
forall (m :: * -> *) a b.
Monad m =>
m (Maybe a) -> m b -> (a -> m b) -> m b
caseMaybeM (Term -> TCMT IO (Maybe QName)
isDataOrRecord (Term -> TCMT IO (Maybe QName)) -> Term -> TCMT IO (Maybe QName)
forall a b. (a -> b) -> a -> b
$ Type -> Term
forall t a. Type'' t a -> a
unEl Type
t') (Type -> TCM (Maybe ConHead)
forall (m :: * -> *) a.
(MonadTCEnv m, ReadTCState m, MonadError TCErr m) =>
Type -> m a
badCon Type
t') ((QName -> TCM (Maybe ConHead)) -> TCM (Maybe ConHead))
-> (QName -> TCM (Maybe ConHead)) -> TCM (Maybe ConHead)
forall a b. (a -> b) -> a -> b
$ \ QName
d ->
                 case [ ConHead
c | (QName
d', ConHead
c) <- [(QName, ConHead)]
dcs, QName
d QName -> QName -> Bool
forall a. Eq a => a -> a -> Bool
== QName
d' ] of
                   [ConHead
c] -> do
                     VerboseKey -> VerboseLevel -> VerboseKey -> TCMT IO ()
forall (m :: * -> *).
MonadDebug m =>
VerboseKey -> VerboseLevel -> VerboseKey -> m ()
reportSLn VerboseKey
"tc.check.term.con" VerboseLevel
40 (VerboseKey -> TCMT IO ()) -> VerboseKey -> TCMT IO ()
forall a b. (a -> b) -> a -> b
$ VerboseKey
"  decided on: " VerboseKey -> VerboseKey -> VerboseKey
forall a. [a] -> [a] -> [a]
++ ConHead -> VerboseKey
forall a. Pretty a => a -> VerboseKey
prettyShow ConHead
c
                     QName -> TCMT IO ()
storeDisambiguatedName (QName -> TCMT IO ()) -> QName -> TCMT IO ()
forall a b. (a -> b) -> a -> b
$ ConHead -> QName
conName ConHead
c
                     Maybe ConHead -> TCM (Maybe ConHead)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ConHead -> TCM (Maybe ConHead))
-> Maybe ConHead -> TCM (Maybe ConHead)
forall a b. (a -> b) -> a -> b
$ ConHead -> Maybe ConHead
forall a. a -> Maybe a
Just ConHead
c
                   []  -> Type -> TCM (Maybe ConHead)
forall (m :: * -> *) a.
(MonadTCEnv m, ReadTCState m, MonadError TCErr m) =>
Type -> m a
badCon (Type -> TCM (Maybe ConHead)) -> Type -> TCM (Maybe ConHead)
forall a b. (a -> b) -> a -> b
$ Type
t' Type -> Term -> Type
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> QName -> [Elim' Term] -> Term
Def QName
d []
                   [ConHead]
cs  -> TypeError -> TCM (Maybe ConHead)
forall (m :: * -> *) a.
(MonadTCEnv m, ReadTCState m, MonadError TCErr m) =>
TypeError -> m a
typeError (TypeError -> TCM (Maybe ConHead))
-> TypeError -> TCM (Maybe ConHead)
forall a b. (a -> b) -> a -> b
$ QName -> [QName] -> TypeError
CantResolveOverloadedConstructorsTargetingSameDatatype QName
d ([QName] -> TypeError) -> [QName] -> TypeError
forall a b. (a -> b) -> a -> b
$ (ConHead -> QName) -> [ConHead] -> [QName]
forall a b. (a -> b) -> [a] -> [b]
map ConHead -> QName
conName [ConHead]
cs
      TCM (Maybe ConHead)
getCon TCM (Maybe ConHead)
-> (Maybe ConHead -> TCM (Either (TCM Bool) ConHead))
-> TCM (Either (TCM Bool) ConHead)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ case
        Maybe ConHead
Nothing -> Either (TCM Bool) ConHead -> TCM (Either (TCM Bool) ConHead)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (TCM Bool) ConHead -> TCM (Either (TCM Bool) ConHead))
-> Either (TCM Bool) ConHead -> TCM (Either (TCM Bool) ConHead)
forall a b. (a -> b) -> a -> b
$ TCM Bool -> Either (TCM Bool) ConHead
forall a b. a -> Either a b
Left (TCM Bool -> Either (TCM Bool) ConHead)
-> TCM Bool -> Either (TCM Bool) ConHead
forall a b. (a -> b) -> a -> b
$ Maybe ConHead -> Bool
forall a. Maybe a -> Bool
isJust (Maybe ConHead -> Bool) -> TCM (Maybe ConHead) -> TCM Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TCM (Maybe ConHead)
getCon
        Just ConHead
c  -> Either (TCM Bool) ConHead -> TCM (Either (TCM Bool) ConHead)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (TCM Bool) ConHead -> TCM (Either (TCM Bool) ConHead))
-> Either (TCM Bool) ConHead -> TCM (Either (TCM Bool) ConHead)
forall a b. (a -> b) -> a -> b
$ ConHead -> Either (TCM Bool) ConHead
forall a b. b -> Either a b
Right ConHead
c

---------------------------------------------------------------------------
-- * Projections
---------------------------------------------------------------------------

-- | Inferring the type of an overloaded projection application.
--   See 'inferOrCheckProjApp'.

inferProjApp :: A.Expr -> ProjOrigin -> NonEmpty QName -> A.Args -> TCM (Term, Type)
inferProjApp :: Expr -> ProjOrigin -> NonEmpty QName -> Args -> TCM (Term, Type)
inferProjApp Expr
e ProjOrigin
o NonEmpty QName
ds Args
args0 = do
  (Term
v, Type
t, CheckedTarget
_) <- Expr
-> ProjOrigin
-> NonEmpty QName
-> Args
-> Maybe (Comparison, Type)
-> TCM (Term, Type, CheckedTarget)
inferOrCheckProjApp Expr
e ProjOrigin
o NonEmpty QName
ds Args
args0 Maybe (Comparison, Type)
forall a. Maybe a
Nothing
  (Term, Type) -> TCM (Term, Type)
forall (m :: * -> *) a. Monad m => a -> m a
return (Term
v, Type
t)

-- | Checking the type of an overloaded projection application.
--   See 'inferOrCheckProjApp'.

checkProjApp  :: Comparison -> A.Expr -> ProjOrigin -> NonEmpty QName -> A.Args -> Type -> TCM Term
checkProjApp :: Comparison
-> Expr -> ProjOrigin -> NonEmpty QName -> Args -> Type -> TCM Term
checkProjApp Comparison
cmp Expr
e ProjOrigin
o NonEmpty QName
ds Args
args0 Type
t = do
  (Term
v, Type
ti, CheckedTarget
targetCheck) <- Expr
-> ProjOrigin
-> NonEmpty QName
-> Args
-> Maybe (Comparison, Type)
-> TCM (Term, Type, CheckedTarget)
inferOrCheckProjApp Expr
e ProjOrigin
o NonEmpty QName
ds Args
args0 ((Comparison, Type) -> Maybe (Comparison, Type)
forall a. a -> Maybe a
Just (Comparison
cmp, Type
t))
  Comparison -> CheckedTarget -> Term -> Type -> Type -> TCM Term
coerce' Comparison
cmp CheckedTarget
targetCheck Term
v Type
ti Type
t

-- | Checking the type of an overloaded projection application.
--   See 'inferOrCheckProjAppToKnownPrincipalArg'.

checkProjAppToKnownPrincipalArg  :: Comparison -> A.Expr -> ProjOrigin -> NonEmpty QName -> A.Args -> Type -> Int -> Term -> Type -> TCM Term
checkProjAppToKnownPrincipalArg :: Comparison
-> Expr
-> ProjOrigin
-> NonEmpty QName
-> Args
-> Type
-> VerboseLevel
-> Term
-> Type
-> TCM Term
checkProjAppToKnownPrincipalArg Comparison
cmp Expr
e ProjOrigin
o NonEmpty QName
ds Args
args0 Type
t VerboseLevel
k Term
v0 Type
pt = do
  (Term
v, Type
ti, CheckedTarget
targetCheck) <- Expr
-> ProjOrigin
-> NonEmpty QName
-> Args
-> Maybe (Comparison, Type)
-> VerboseLevel
-> Term
-> Type
-> TCM (Term, Type, CheckedTarget)
inferOrCheckProjAppToKnownPrincipalArg Expr
e ProjOrigin
o NonEmpty QName
ds Args
args0 ((Comparison, Type) -> Maybe (Comparison, Type)
forall a. a -> Maybe a
Just (Comparison
cmp, Type
t)) VerboseLevel
k Term
v0 Type
pt
  Comparison -> CheckedTarget -> Term -> Type -> Type -> TCM Term
coerce' Comparison
cmp CheckedTarget
targetCheck Term
v Type
ti Type
t

-- | Inferring or Checking an overloaded projection application.
--
--   The overloaded projection is disambiguated by inferring the type of its
--   principal argument, which is the first visible argument.

inferOrCheckProjApp
  :: A.Expr
     -- ^ The whole expression which constitutes the application.
  -> ProjOrigin
     -- ^ The origin of the projection involved in this projection application.
  -> NonEmpty QName
     -- ^ The projection name (potentially ambiguous).
  -> A.Args
     -- ^ The arguments to the projection.
  -> Maybe (Comparison, Type)
     -- ^ The expected type of the expression (if 'Nothing', infer it).
  -> TCM (Term, Type, CheckedTarget)
     -- ^ The type-checked expression and its type (if successful).
inferOrCheckProjApp :: Expr
-> ProjOrigin
-> NonEmpty QName
-> Args
-> Maybe (Comparison, Type)
-> TCM (Term, Type, CheckedTarget)
inferOrCheckProjApp Expr
e ProjOrigin
o NonEmpty QName
ds Args
args Maybe (Comparison, Type)
mt = do
  VerboseKey -> VerboseLevel -> TCM Doc -> TCMT IO ()
forall (m :: * -> *).
MonadDebug m =>
VerboseKey -> VerboseLevel -> TCM Doc -> m ()
reportSDoc VerboseKey
"tc.proj.amb" VerboseLevel
20 (TCM Doc -> TCMT IO ()) -> TCM Doc -> TCMT IO ()
forall a b. (a -> b) -> a -> b
$ [TCM Doc] -> TCM Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
vcat
    [ TCM Doc
"checking ambiguous projection"
    , VerboseKey -> TCM Doc
forall (m :: * -> *). Monad m => VerboseKey -> m Doc
text (VerboseKey -> TCM Doc) -> VerboseKey -> TCM Doc
forall a b. (a -> b) -> a -> b
$ VerboseKey
"  ds   = " VerboseKey -> VerboseKey -> VerboseKey
forall a. [a] -> [a] -> [a]
++ NonEmpty QName -> VerboseKey
forall a. Pretty a => a -> VerboseKey
prettyShow NonEmpty QName
ds
    , VerboseKey -> TCM Doc
forall (m :: * -> *). Monad m => VerboseKey -> m Doc
text   VerboseKey
"  args = " TCM Doc -> TCM Doc -> TCM Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> [TCM Doc] -> TCM Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
sep ((NamedArg Expr -> TCM Doc) -> Args -> [TCM Doc]
forall a b. (a -> b) -> [a] -> [b]
map NamedArg Expr -> TCM Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM Args
args)
    , VerboseKey -> TCM Doc
forall (m :: * -> *). Monad m => VerboseKey -> m Doc
text   VerboseKey
"  t    = " TCM Doc -> TCM Doc -> TCM Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> Maybe (Comparison, Type)
-> TCM Doc -> ((Comparison, Type) -> TCM Doc) -> TCM Doc
forall a b. Maybe a -> b -> (a -> b) -> b
caseMaybe Maybe (Comparison, Type)
mt TCM Doc
"Nothing" (Comparison, Type) -> TCM Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM
    ]

  let cmp :: Comparison
cmp = Maybe (Comparison, Type)
-> Comparison -> ((Comparison, Type) -> Comparison) -> Comparison
forall a b. Maybe a -> b -> (a -> b) -> b
caseMaybe Maybe (Comparison, Type)
mt Comparison
CmpEq (Comparison, Type) -> Comparison
forall a b. (a, b) -> a
fst

      -- Postpone the whole type checking problem
      -- if type of principal argument (or the type where we get it from)
      -- is blocked by meta m.
      postpone :: a -> TCM (Term, Type, CheckedTarget)
postpone a
m = do
        Type
tc <- Maybe (Comparison, Type)
-> TCMT IO Type
-> ((Comparison, Type) -> TCMT IO Type)
-> TCMT IO Type
forall a b. Maybe a -> b -> (a -> b) -> b
caseMaybe Maybe (Comparison, Type)
mt TCMT IO Type
newTypeMeta_ (Type -> TCMT IO Type
forall (m :: * -> *) a. Monad m => a -> m a
return (Type -> TCMT IO Type)
-> ((Comparison, Type) -> Type)
-> (Comparison, Type)
-> TCMT IO Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Comparison, Type) -> Type
forall a b. (a, b) -> b
snd)
        Term
v <- TypeCheckingProblem -> TCM Bool -> TCM Term
postponeTypeCheckingProblem (Comparison -> Expr -> Type -> TypeCheckingProblem
CheckExpr Comparison
cmp Expr
e Type
tc) (TCM Bool -> TCM Term) -> TCM Bool -> TCM Term
forall a b. (a -> b) -> a -> b
$ a -> TCM Bool
forall a (m :: * -> *).
(IsInstantiatedMeta a, MonadFail m, ReadTCState m) =>
a -> m Bool
isInstantiatedMeta a
m
        (Term, Type, CheckedTarget) -> TCM (Term, Type, CheckedTarget)
forall (m :: * -> *) a. Monad m => a -> m a
return (Term
v, Type
tc, CheckedTarget
NotCheckedTarget)

  -- The following cases need to be considered:
  -- 1. No arguments to the projection.
  -- 2. Arguments (parameters), but not the principal argument.
  -- 3. Argument(s) including the principal argument.

  -- For now, we only allow ambiguous projections if the first visible
  -- argument is the record value.

  case ((VerboseLevel, NamedArg Expr) -> Bool)
-> [(VerboseLevel, NamedArg Expr)]
-> [(VerboseLevel, NamedArg Expr)]
forall a. (a -> Bool) -> [a] -> [a]
filter (NamedArg Expr -> Bool
forall a. LensHiding a => a -> Bool
visible (NamedArg Expr -> Bool)
-> ((VerboseLevel, NamedArg Expr) -> NamedArg Expr)
-> (VerboseLevel, NamedArg Expr)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (VerboseLevel, NamedArg Expr) -> NamedArg Expr
forall a b. (a, b) -> b
snd) ([(VerboseLevel, NamedArg Expr)]
 -> [(VerboseLevel, NamedArg Expr)])
-> [(VerboseLevel, NamedArg Expr)]
-> [(VerboseLevel, NamedArg Expr)]
forall a b. (a -> b) -> a -> b
$ [VerboseLevel] -> Args -> [(VerboseLevel, NamedArg Expr)]
forall a b. [a] -> [b] -> [(a, b)]
zip [VerboseLevel
0..] Args
args of

    -- Case: we have no visible argument to the projection.
    -- In inference mode, we really need the visible argument, postponing does not help
    [] -> Maybe (Comparison, Type)
-> TCM (Term, Type, CheckedTarget)
-> ((Comparison, Type) -> TCM (Term, Type, CheckedTarget))
-> TCM (Term, Type, CheckedTarget)
forall a b. Maybe a -> b -> (a -> b) -> b
caseMaybe Maybe (Comparison, Type)
mt (NonEmpty QName -> TCM (Term, Type, CheckedTarget)
forall a. NonEmpty QName -> TCM a
refuseProjNotApplied NonEmpty QName
ds) (((Comparison, Type) -> TCM (Term, Type, CheckedTarget))
 -> TCM (Term, Type, CheckedTarget))
-> ((Comparison, Type) -> TCM (Term, Type, CheckedTarget))
-> TCM (Term, Type, CheckedTarget)
forall a b. (a -> b) -> a -> b
$ \ (Comparison
cmp , Type
t) -> do
      -- If we have the type, we can try to get the type of the principal argument.
      -- It is the first visible argument.
      TelV Tele (Dom Type)
_ptel Type
core <- VerboseLevel -> (Dom Type -> Bool) -> Type -> TCMT IO (TelV Type)
forall (m :: * -> *).
(MonadReduce m, MonadAddContext m) =>
VerboseLevel -> (Dom Type -> Bool) -> Type -> m (TelV Type)
telViewUpTo' (-VerboseLevel
1) (Bool -> Bool
not (Bool -> Bool) -> (Dom Type -> Bool) -> Dom Type -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dom Type -> Bool
forall a. LensHiding a => a -> Bool
visible) Type
t
      Type
-> (MetaId -> Type -> TCM (Term, Type, CheckedTarget))
-> (NotBlocked -> Type -> TCM (Term, Type, CheckedTarget))
-> TCM (Term, Type, CheckedTarget)
forall t (m :: * -> *) a.
(Reduce t, IsMeta t, MonadReduce m, HasBuiltins m) =>
t -> (MetaId -> t -> m a) -> (NotBlocked -> t -> m a) -> m a
ifBlocked Type
core (\ MetaId
m Type
_ -> MetaId -> TCM (Term, Type, CheckedTarget)
forall a.
IsInstantiatedMeta a =>
a -> TCM (Term, Type, CheckedTarget)
postpone MetaId
m) ((NotBlocked -> Type -> TCM (Term, Type, CheckedTarget))
 -> TCM (Term, Type, CheckedTarget))
-> (NotBlocked -> Type -> TCM (Term, Type, CheckedTarget))
-> TCM (Term, Type, CheckedTarget)
forall a b. (a -> b) -> a -> b
$ {-else-} \ NotBlocked
_ Type
core -> do
      Type
-> (Type -> TCM (Term, Type, CheckedTarget))
-> (Dom Type -> Abs Type -> TCM (Term, Type, CheckedTarget))
-> TCM (Term, Type, CheckedTarget)
forall (m :: * -> *) a.
MonadReduce m =>
Type -> (Type -> m a) -> (Dom Type -> Abs Type -> m a) -> m a
ifNotPiType Type
core (\ Type
_ -> NonEmpty QName -> TCM (Term, Type, CheckedTarget)
forall a. NonEmpty QName -> TCM a
refuseProjNotApplied NonEmpty QName
ds) ((Dom Type -> Abs Type -> TCM (Term, Type, CheckedTarget))
 -> TCM (Term, Type, CheckedTarget))
-> (Dom Type -> Abs Type -> TCM (Term, Type, CheckedTarget))
-> TCM (Term, Type, CheckedTarget)
forall a b. (a -> b) -> a -> b
$ {-else-} \ Dom Type
dom Abs Type
_b -> do
      Type
-> (MetaId -> Type -> TCM (Term, Type, CheckedTarget))
-> (NotBlocked -> Type -> TCM (Term, Type, CheckedTarget))
-> TCM (Term, Type, CheckedTarget)
forall t (m :: * -> *) a.
(Reduce t, IsMeta t, MonadReduce m, HasBuiltins m) =>
t -> (MetaId -> t -> m a) -> (NotBlocked -> t -> m a) -> m a
ifBlocked (Dom Type -> Type
forall t e. Dom' t e -> e
unDom Dom Type
dom) (\ MetaId
m Type
_ -> MetaId -> TCM (Term, Type, CheckedTarget)
forall a.
IsInstantiatedMeta a =>
a -> TCM (Term, Type, CheckedTarget)
postpone MetaId
m) ((NotBlocked -> Type -> TCM (Term, Type, CheckedTarget))
 -> TCM (Term, Type, CheckedTarget))
-> (NotBlocked -> Type -> TCM (Term, Type, CheckedTarget))
-> TCM (Term, Type, CheckedTarget)
forall a b. (a -> b) -> a -> b
$ {-else-} \ NotBlocked
_ Type
ta -> do
      TCMT IO (Maybe (QName, [Arg Term], Defn))
-> TCM (Term, Type, CheckedTarget)
-> ((QName, [Arg Term], Defn) -> TCM (Term, Type, CheckedTarget))
-> TCM (Term, Type, CheckedTarget)
forall (m :: * -> *) a b.
Monad m =>
m (Maybe a) -> m b -> (a -> m b) -> m b
caseMaybeM (Type -> TCMT IO (Maybe (QName, [Arg Term], Defn))
forall (m :: * -> *).
(MonadReduce m, HasConstInfo m, HasBuiltins m) =>
Type -> m (Maybe (QName, [Arg Term], Defn))
isRecordType Type
ta) (NonEmpty QName -> TCM (Term, Type, CheckedTarget)
forall a. NonEmpty QName -> TCM a
refuseProjNotRecordType NonEmpty QName
ds) (((QName, [Arg Term], Defn) -> TCM (Term, Type, CheckedTarget))
 -> TCM (Term, Type, CheckedTarget))
-> ((QName, [Arg Term], Defn) -> TCM (Term, Type, CheckedTarget))
-> TCM (Term, Type, CheckedTarget)
forall a b. (a -> b) -> a -> b
$ \ (QName
_q, [Arg Term]
_pars, Defn
defn) -> do
      case Defn
defn of
        Record { recFields :: Defn -> [Dom QName]
recFields = [Dom QName]
fs } -> do
          case [Dom QName] -> (Dom QName -> Maybe QName) -> [QName]
forall a b. [a] -> (a -> Maybe b) -> [b]
forMaybe [Dom QName]
fs ((Dom QName -> Maybe QName) -> [QName])
-> (Dom QName -> Maybe QName) -> [QName]
forall a b. (a -> b) -> a -> b
$ \ Dom QName
f -> (QName -> Bool) -> [QName] -> Maybe QName
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
List.find (Dom QName -> QName
forall t e. Dom' t e -> e
unDom Dom QName
f QName -> QName -> Bool
forall a. Eq a => a -> a -> Bool
==) (NonEmpty QName -> [QName]
forall a. NonEmpty a -> [a]
NonEmpty.toList NonEmpty QName
ds) of
            [] -> NonEmpty QName -> TCM (Term, Type, CheckedTarget)
forall a. NonEmpty QName -> TCM a
refuseProjNoMatching NonEmpty QName
ds
            [QName
d] -> do
              QName -> TCMT IO ()
storeDisambiguatedName QName
d
              -- checkHeadApplication will check the target type
              (, Type
t, Maybe ProblemId -> CheckedTarget
CheckedTarget Maybe ProblemId
forall a. Maybe a
Nothing) (Term -> (Term, Type, CheckedTarget))
-> TCM Term -> TCM (Term, Type, CheckedTarget)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                Comparison -> Expr -> Type -> Expr -> Args -> TCM Term
checkHeadApplication Comparison
cmp Expr
e Type
t (ProjOrigin -> AmbiguousQName -> Expr
A.Proj ProjOrigin
o (AmbiguousQName -> Expr) -> AmbiguousQName -> Expr
forall a b. (a -> b) -> a -> b
$ QName -> AmbiguousQName
unambiguous QName
d) Args
args
            [QName]
_ -> TCM (Term, Type, CheckedTarget)
forall a. HasCallStack => a
__IMPOSSIBLE__
        Defn
_ -> TCM (Term, Type, CheckedTarget)
forall a. HasCallStack => a
__IMPOSSIBLE__

    -- Case: we have a visible argument
    ((VerboseLevel
k, NamedArg Expr
arg) : [(VerboseLevel, NamedArg Expr)]
_) -> do
      (Term
v0, Type
ta) <- Expr -> TCM (Term, Type)
inferExpr (Expr -> TCM (Term, Type)) -> Expr -> TCM (Term, Type)
forall a b. (a -> b) -> a -> b
$ NamedArg Expr -> Expr
forall a. NamedArg a -> a
namedArg NamedArg Expr
arg
      VerboseKey -> VerboseLevel -> TCM Doc -> TCMT IO ()
forall (m :: * -> *).
MonadDebug m =>
VerboseKey -> VerboseLevel -> TCM Doc -> m ()
reportSDoc VerboseKey
"tc.proj.amb" VerboseLevel
25 (TCM Doc -> TCMT IO ()) -> TCM Doc -> TCMT IO ()
forall a b. (a -> b) -> a -> b
$ [TCM Doc] -> TCM Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
vcat
        [ TCM Doc
"  principal arg " TCM Doc -> TCM Doc -> TCM Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> NamedArg Expr -> TCM Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM NamedArg Expr
arg
        , TCM Doc
"  has type "      TCM Doc -> TCM Doc -> TCM Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> Type -> TCM Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM Type
ta
        ]
      Expr
-> ProjOrigin
-> NonEmpty QName
-> Args
-> Maybe (Comparison, Type)
-> VerboseLevel
-> Term
-> Type
-> TCM (Term, Type, CheckedTarget)
inferOrCheckProjAppToKnownPrincipalArg Expr
e ProjOrigin
o NonEmpty QName
ds Args
args Maybe (Comparison, Type)
mt VerboseLevel
k Term
v0 Type
ta

-- | Same arguments 'inferOrCheckProjApp' above but also gets the position,
--   value and type of the principal argument.
inferOrCheckProjAppToKnownPrincipalArg ::
  A.Expr -> ProjOrigin -> NonEmpty QName -> A.Args -> Maybe (Comparison, Type) ->
  Int -> Term -> Type -> TCM (Term, Type, CheckedTarget)
inferOrCheckProjAppToKnownPrincipalArg :: Expr
-> ProjOrigin
-> NonEmpty QName
-> Args
-> Maybe (Comparison, Type)
-> VerboseLevel
-> Term
-> Type
-> TCM (Term, Type, CheckedTarget)
inferOrCheckProjAppToKnownPrincipalArg Expr
e ProjOrigin
o NonEmpty QName
ds Args
args Maybe (Comparison, Type)
mt VerboseLevel
k Term
v0 Type
ta = do
  let cmp :: Comparison
cmp = Maybe (Comparison, Type)
-> Comparison -> ((Comparison, Type) -> Comparison) -> Comparison
forall a b. Maybe a -> b -> (a -> b) -> b
caseMaybe Maybe (Comparison, Type)
mt Comparison
CmpEq (Comparison, Type) -> Comparison
forall a b. (a, b) -> a
fst
      postpone :: a -> TCM (Term, Type, CheckedTarget)
postpone a
m = do
        Type
tc <- Maybe (Comparison, Type)
-> TCMT IO Type
-> ((Comparison, Type) -> TCMT IO Type)
-> TCMT IO Type
forall a b. Maybe a -> b -> (a -> b) -> b
caseMaybe Maybe (Comparison, Type)
mt TCMT IO Type
newTypeMeta_ (Type -> TCMT IO Type
forall (m :: * -> *) a. Monad m => a -> m a
return (Type -> TCMT IO Type)
-> ((Comparison, Type) -> Type)
-> (Comparison, Type)
-> TCMT IO Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Comparison, Type) -> Type
forall a b. (a, b) -> b
snd)
        Term
v <- TypeCheckingProblem -> TCM Bool -> TCM Term
postponeTypeCheckingProblem (Comparison
-> Expr
-> ProjOrigin
-> NonEmpty QName
-> Args
-> Type
-> VerboseLevel
-> Term
-> Type
-> TypeCheckingProblem
CheckProjAppToKnownPrincipalArg Comparison
cmp Expr
e ProjOrigin
o NonEmpty QName
ds Args
args Type
tc VerboseLevel
k Term
v0 Type
ta) (TCM Bool -> TCM Term) -> TCM Bool -> TCM Term
forall a b. (a -> b) -> a -> b
$ a -> TCM Bool
forall a (m :: * -> *).
(IsInstantiatedMeta a, MonadFail m, ReadTCState m) =>
a -> m Bool
isInstantiatedMeta a
m
        (Term, Type, CheckedTarget) -> TCM (Term, Type, CheckedTarget)
forall (m :: * -> *) a. Monad m => a -> m a
return (Term
v, Type
tc, CheckedTarget
NotCheckedTarget)
  -- ta should be a record type (after introducing the hidden args in v0)
  ([Arg Term]
vargs, Type
ta) <- VerboseLevel -> (Hiding -> Bool) -> Type -> TCM ([Arg Term], Type)
forall (m :: * -> *).
(MonadReduce m, MonadMetaSolver m, MonadDebug m, MonadTCM m) =>
VerboseLevel -> (Hiding -> Bool) -> Type -> m ([Arg Term], Type)
implicitArgs (-VerboseLevel
1) (Bool -> Bool
not (Bool -> Bool) -> (Hiding -> Bool) -> Hiding -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hiding -> Bool
forall a. LensHiding a => a -> Bool
visible) Type
ta
  let v :: Term
v = Term
v0 Term -> [Arg Term] -> Term
forall t. Apply t => t -> [Arg Term] -> t
`apply` [Arg Term]
vargs
  Type
-> (MetaId -> Type -> TCM (Term, Type, CheckedTarget))
-> (NotBlocked -> Type -> TCM (Term, Type, CheckedTarget))
-> TCM (Term, Type, CheckedTarget)
forall t (m :: * -> *) a.
(Reduce t, IsMeta t, MonadReduce m, HasBuiltins m) =>
t -> (MetaId -> t -> m a) -> (NotBlocked -> t -> m a) -> m a
ifBlocked Type
ta (\ MetaId
m Type
_ -> MetaId -> TCM (Term, Type, CheckedTarget)
forall a.
IsInstantiatedMeta a =>
a -> TCM (Term, Type, CheckedTarget)
postpone MetaId
m) {-else-} ((NotBlocked -> Type -> TCM (Term, Type, CheckedTarget))
 -> TCM (Term, Type, CheckedTarget))
-> (NotBlocked -> Type -> TCM (Term, Type, CheckedTarget))
-> TCM (Term, Type, CheckedTarget)
forall a b. (a -> b) -> a -> b
$ \ NotBlocked
_ Type
ta -> do
  TCMT IO (Maybe (QName, [Arg Term], Defn))
-> TCM (Term, Type, CheckedTarget)
-> ((QName, [Arg Term], Defn) -> TCM (Term, Type, CheckedTarget))
-> TCM (Term, Type, CheckedTarget)
forall (m :: * -> *) a b.
Monad m =>
m (Maybe a) -> m b -> (a -> m b) -> m b
caseMaybeM (Type -> TCMT IO (Maybe (QName, [Arg Term], Defn))
forall (m :: * -> *).
(MonadReduce m, HasConstInfo m, HasBuiltins m) =>
Type -> m (Maybe (QName, [Arg Term], Defn))
isRecordType Type
ta) (NonEmpty QName -> TCM (Term, Type, CheckedTarget)
forall a. NonEmpty QName -> TCM a
refuseProjNotRecordType NonEmpty QName
ds) (((QName, [Arg Term], Defn) -> TCM (Term, Type, CheckedTarget))
 -> TCM (Term, Type, CheckedTarget))
-> ((QName, [Arg Term], Defn) -> TCM (Term, Type, CheckedTarget))
-> TCM (Term, Type, CheckedTarget)
forall a b. (a -> b) -> a -> b
$ \ (QName
q, [Arg Term]
_pars0, Defn
_) -> do

      -- try to project it with all of the possible projections
      let try :: QName
-> MaybeT
     TCM (QName, (QName, ([Arg Term], (Dom Type, Term, Type))))
try QName
d = do
            VerboseKey -> VerboseLevel -> TCM Doc -> MaybeT TCM ()
forall (m :: * -> *).
MonadDebug m =>
VerboseKey -> VerboseLevel -> TCM Doc -> m ()
reportSDoc VerboseKey
"tc.proj.amb" VerboseLevel
30 (TCM Doc -> MaybeT TCM ()) -> TCM Doc -> MaybeT TCM ()
forall a b. (a -> b) -> a -> b
$ [TCM Doc] -> TCM Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
vcat
              [ VerboseKey -> TCM Doc
forall (m :: * -> *). Monad m => VerboseKey -> m Doc
text (VerboseKey -> TCM Doc) -> VerboseKey -> TCM Doc
forall a b. (a -> b) -> a -> b
$ VerboseKey
"trying projection " VerboseKey -> VerboseKey -> VerboseKey
forall a. [a] -> [a] -> [a]
++ QName -> VerboseKey
forall a. Pretty a => a -> VerboseKey
prettyShow QName
d
              , TCM Doc
"  td  = " TCM Doc -> TCM Doc -> TCM Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> TCMT IO (Maybe Type) -> TCM Doc -> (Type -> TCM Doc) -> TCM Doc
forall (m :: * -> *) a b.
Monad m =>
m (Maybe a) -> m b -> (a -> m b) -> m b
caseMaybeM (QName -> Type -> TCMT IO (Maybe Type)
forall (m :: * -> *).
(HasConstInfo m, MonadReduce m, MonadDebug m) =>
QName -> Type -> m (Maybe Type)
getDefType QName
d Type
ta) TCM Doc
"Nothing" Type -> TCM Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM
              ]

            -- get the original projection name
            Definition
def <- TCMT IO Definition -> MaybeT TCM Definition
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (TCMT IO Definition -> MaybeT TCM Definition)
-> TCMT IO Definition -> MaybeT TCM Definition
forall a b. (a -> b) -> a -> b
$ QName -> TCMT IO Definition
forall (m :: * -> *). HasConstInfo m => QName -> m Definition
getConstInfo QName
d
            let isP :: Maybe Projection
isP = Defn -> Maybe Projection
isProjection_ (Defn -> Maybe Projection) -> Defn -> Maybe Projection
forall a b. (a -> b) -> a -> b
$ Definition -> Defn
theDef Definition
def
            VerboseKey -> VerboseLevel -> TCM Doc -> MaybeT TCM ()
forall (m :: * -> *).
MonadDebug m =>
VerboseKey -> VerboseLevel -> TCM Doc -> m ()
reportSDoc VerboseKey
"tc.proj.amb" VerboseLevel
40 (TCM Doc -> MaybeT TCM ()) -> TCM Doc -> MaybeT TCM ()
forall a b. (a -> b) -> a -> b
$ [TCM Doc] -> TCM Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
vcat ([TCM Doc] -> TCM Doc) -> [TCM Doc] -> TCM Doc
forall a b. (a -> b) -> a -> b
$
              [ VerboseKey -> TCM Doc
forall (m :: * -> *). Monad m => VerboseKey -> m Doc
text (VerboseKey -> TCM Doc) -> VerboseKey -> TCM Doc
forall a b. (a -> b) -> a -> b
$ VerboseKey
"  isProjection = " VerboseKey -> VerboseKey -> VerboseKey
forall a. [a] -> [a] -> [a]
++ Maybe Projection
-> VerboseKey -> (Projection -> VerboseKey) -> VerboseKey
forall a b. Maybe a -> b -> (a -> b) -> b
caseMaybe Maybe Projection
isP VerboseKey
"no" (VerboseKey -> Projection -> VerboseKey
forall a b. a -> b -> a
const VerboseKey
"yes")
              ] [TCM Doc] -> [TCM Doc] -> [TCM Doc]
forall a. [a] -> [a] -> [a]
++ Maybe Projection
-> [TCM Doc] -> (Projection -> [TCM Doc]) -> [TCM Doc]
forall a b. Maybe a -> b -> (a -> b) -> b
caseMaybe Maybe Projection
isP [] (\ Projection{ projProper :: Projection -> Maybe QName
projProper = Maybe QName
proper, projOrig :: Projection -> QName
projOrig = QName
orig } ->
              [ VerboseKey -> TCM Doc
forall (m :: * -> *). Monad m => VerboseKey -> m Doc
text (VerboseKey -> TCM Doc) -> VerboseKey -> TCM Doc
forall a b. (a -> b) -> a -> b
$ VerboseKey
"  proper       = " VerboseKey -> VerboseKey -> VerboseKey
forall a. [a] -> [a] -> [a]
++ Maybe QName -> VerboseKey
forall a. Show a => a -> VerboseKey
show Maybe QName
proper
              , VerboseKey -> TCM Doc
forall (m :: * -> *). Monad m => VerboseKey -> m Doc
text (VerboseKey -> TCM Doc) -> VerboseKey -> TCM Doc
forall a b. (a -> b) -> a -> b
$ VerboseKey
"  orig         = " VerboseKey -> VerboseKey -> VerboseKey
forall a. [a] -> [a] -> [a]
++ QName -> VerboseKey
forall a. Pretty a => a -> VerboseKey
prettyShow QName
orig
              ])

            -- Andreas, 2017-01-21, issue #2422
            -- The scope checker considers inherited projections (from nested records)
            -- as projections and allows overloading.  However, since they are defined
            -- as *composition* of projections, the type checker does *not* recognize them,
            -- and @isP@ will be @Nothing@.
            -- However, we can ignore this, as we only need the @orig@inal projection name
            -- for removing false ambiguity.  Thus, we skip these checks:

            -- Projection{ projProper = proper, projOrig = orig } <- MaybeT $ return isP
            -- guard $ isJust proper
            let orig :: QName
orig = Maybe Projection -> QName -> (Projection -> QName) -> QName
forall a b. Maybe a -> b -> (a -> b) -> b
caseMaybe Maybe Projection
isP QName
d Projection -> QName
projOrig

            -- try to eliminate
            (Dom Type
dom, Term
u, Type
tb) <- TCMT IO (Maybe (Dom Type, Term, Type))
-> MaybeT TCM (Dom Type, Term, Type)
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (Term
-> Type
-> ProjOrigin
-> QName
-> TCMT IO (Maybe (Dom Type, Term, Type))
forall (m :: * -> *).
(HasConstInfo m, MonadReduce m, MonadDebug m) =>
Term
-> Type -> ProjOrigin -> QName -> m (Maybe (Dom Type, Term, Type))
projectTyped Term
v Type
ta ProjOrigin
o QName
d TCMT IO (Maybe (Dom Type, Term, Type))
-> (TCErr -> TCMT IO (Maybe (Dom Type, Term, Type)))
-> TCMT IO (Maybe (Dom Type, Term, Type))
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
`catchError` \ TCErr
_ -> Maybe (Dom Type, Term, Type)
-> TCMT IO (Maybe (Dom Type, Term, Type))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Dom Type, Term, Type)
forall a. Maybe a
Nothing)
            VerboseKey -> VerboseLevel -> TCM Doc -> MaybeT TCM ()
forall (m :: * -> *).
MonadDebug m =>
VerboseKey -> VerboseLevel -> TCM Doc -> m ()
reportSDoc VerboseKey
"tc.proj.amb" VerboseLevel
30 (TCM Doc -> MaybeT TCM ()) -> TCM Doc -> MaybeT TCM ()
forall a b. (a -> b) -> a -> b
$ [TCM Doc] -> TCM Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
vcat
              [ TCM Doc
"  dom = " TCM Doc -> TCM Doc -> TCM Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> Dom Type -> TCM Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM Dom Type
dom
              , TCM Doc
"  u   = " TCM Doc -> TCM Doc -> TCM Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> Term -> TCM Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM Term
u
              , TCM Doc
"  tb  = " TCM Doc -> TCM Doc -> TCM Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> Type -> TCM Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM Type
tb
              ]
            (QName
q', [Arg Term]
pars, Defn
_) <- TCMT IO (Maybe (QName, [Arg Term], Defn))
-> MaybeT TCM (QName, [Arg Term], Defn)
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (TCMT IO (Maybe (QName, [Arg Term], Defn))
 -> MaybeT TCM (QName, [Arg Term], Defn))
-> TCMT IO (Maybe (QName, [Arg Term], Defn))
-> MaybeT TCM (QName, [Arg Term], Defn)
forall a b. (a -> b) -> a -> b
$ Type -> TCMT IO (Maybe (QName, [Arg Term], Defn))
forall (m :: * -> *).
(MonadReduce m, HasConstInfo m, HasBuiltins m) =>
Type -> m (Maybe (QName, [Arg Term], Defn))
isRecordType (Type -> TCMT IO (Maybe (QName, [Arg Term], Defn)))
-> Type -> TCMT IO (Maybe (QName, [Arg Term], Defn))
forall a b. (a -> b) -> a -> b
$ Dom Type -> Type
forall t e. Dom' t e -> e
unDom Dom Type
dom
            VerboseKey -> VerboseLevel -> TCM Doc -> MaybeT TCM ()
forall (m :: * -> *).
MonadDebug m =>
VerboseKey -> VerboseLevel -> TCM Doc -> m ()
reportSDoc VerboseKey
"tc.proj.amb" VerboseLevel
30 (TCM Doc -> MaybeT TCM ()) -> TCM Doc -> MaybeT TCM ()
forall a b. (a -> b) -> a -> b
$ [TCM Doc] -> TCM Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
vcat
              [ TCM Doc
"  q   = " TCM Doc -> TCM Doc -> TCM Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> QName -> TCM Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM QName
q
              , TCM Doc
"  q'  = " TCM Doc -> TCM Doc -> TCM Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> QName -> TCM Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM QName
q'
              ]
            Bool -> MaybeT TCM ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (QName
q QName -> QName -> Bool
forall a. Eq a => a -> a -> Bool
== QName
q')
            -- Get the type of the projection and check
            -- that the first visible argument is the record value.
            let tfull :: Type
tfull = Definition -> Type
defType Definition
def
            TelV Tele (Dom Type)
tel Type
_ <- TCMT IO (TelV Type) -> MaybeT TCM (TelV Type)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (TCMT IO (TelV Type) -> MaybeT TCM (TelV Type))
-> TCMT IO (TelV Type) -> MaybeT TCM (TelV Type)
forall a b. (a -> b) -> a -> b
$ VerboseLevel -> (Dom Type -> Bool) -> Type -> TCMT IO (TelV Type)
forall (m :: * -> *).
(MonadReduce m, MonadAddContext m) =>
VerboseLevel -> (Dom Type -> Bool) -> Type -> m (TelV Type)
telViewUpTo' (-VerboseLevel
1) (Bool -> Bool
not (Bool -> Bool) -> (Dom Type -> Bool) -> Dom Type -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dom Type -> Bool
forall a. LensHiding a => a -> Bool
visible) Type
tfull
            VerboseKey -> VerboseLevel -> TCM Doc -> MaybeT TCM ()
forall (m :: * -> *).
MonadDebug m =>
VerboseKey -> VerboseLevel -> TCM Doc -> m ()
reportSDoc VerboseKey
"tc.proj.amb" VerboseLevel
30 (TCM Doc -> MaybeT TCM ()) -> TCM Doc -> MaybeT TCM ()
forall a b. (a -> b) -> a -> b
$ [TCM Doc] -> TCM Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
vcat
              [ VerboseKey -> TCM Doc
forall (m :: * -> *). Monad m => VerboseKey -> m Doc
text (VerboseKey -> TCM Doc) -> VerboseKey -> TCM Doc
forall a b. (a -> b) -> a -> b
$ VerboseKey
"  size tel  = " VerboseKey -> VerboseKey -> VerboseKey
forall a. [a] -> [a] -> [a]
++ VerboseLevel -> VerboseKey
forall a. Show a => a -> VerboseKey
show (Tele (Dom Type) -> VerboseLevel
forall a. Sized a => a -> VerboseLevel
size Tele (Dom Type)
tel)
              , VerboseKey -> TCM Doc
forall (m :: * -> *). Monad m => VerboseKey -> m Doc
text (VerboseKey -> TCM Doc) -> VerboseKey -> TCM Doc
forall a b. (a -> b) -> a -> b
$ VerboseKey
"  size pars = " VerboseKey -> VerboseKey -> VerboseKey
forall a. [a] -> [a] -> [a]
++ VerboseLevel -> VerboseKey
forall a. Show a => a -> VerboseKey
show ([Arg Term] -> VerboseLevel
forall a. Sized a => a -> VerboseLevel
size [Arg Term]
pars)
              ]
            -- See issue 1960 for when the following assertion fails for
            -- the correct disambiguation.
            -- guard (size tel == size pars)

            Bool -> MaybeT TCM ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> MaybeT TCM ()) -> MaybeT TCM Bool -> MaybeT TCM ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< do Maybe TypeError -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe TypeError -> Bool)
-> MaybeT TCM (Maybe TypeError) -> MaybeT TCM Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do TCM (Maybe TypeError) -> MaybeT TCM (Maybe TypeError)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (TCM (Maybe TypeError) -> MaybeT TCM (Maybe TypeError))
-> TCM (Maybe TypeError) -> MaybeT TCM (Maybe TypeError)
forall a b. (a -> b) -> a -> b
$ QName -> Definition -> TCM (Maybe TypeError)
checkModality' QName
d Definition
def
            (QName, (QName, ([Arg Term], (Dom Type, Term, Type))))
-> MaybeT
     TCM (QName, (QName, ([Arg Term], (Dom Type, Term, Type))))
forall (m :: * -> *) a. Monad m => a -> m a
return (QName
orig, (QName
d, ([Arg Term]
pars, (Dom Type
dom, Term
u, Type
tb))))

      [[(QName, (QName, ([Arg Term], (Dom Type, Term, Type))))]]
cands <- ((QName, (QName, ([Arg Term], (Dom Type, Term, Type)))) -> QName)
-> [(QName, (QName, ([Arg Term], (Dom Type, Term, Type))))]
-> [[(QName, (QName, ([Arg Term], (Dom Type, Term, Type))))]]
forall b a. Ord b => (a -> b) -> [a] -> [[a]]
groupOn (QName, (QName, ([Arg Term], (Dom Type, Term, Type)))) -> QName
forall a b. (a, b) -> a
fst ([(QName, (QName, ([Arg Term], (Dom Type, Term, Type))))]
 -> [[(QName, (QName, ([Arg Term], (Dom Type, Term, Type))))]])
-> ([Maybe (QName, (QName, ([Arg Term], (Dom Type, Term, Type))))]
    -> [(QName, (QName, ([Arg Term], (Dom Type, Term, Type))))])
-> [Maybe (QName, (QName, ([Arg Term], (Dom Type, Term, Type))))]
-> [[(QName, (QName, ([Arg Term], (Dom Type, Term, Type))))]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe (QName, (QName, ([Arg Term], (Dom Type, Term, Type))))]
-> [(QName, (QName, ([Arg Term], (Dom Type, Term, Type))))]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (QName, (QName, ([Arg Term], (Dom Type, Term, Type))))]
 -> [[(QName, (QName, ([Arg Term], (Dom Type, Term, Type))))]])
-> TCMT
     IO [Maybe (QName, (QName, ([Arg Term], (Dom Type, Term, Type))))]
-> TCMT
     IO [[(QName, (QName, ([Arg Term], (Dom Type, Term, Type))))]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName
 -> TCMT
      IO (Maybe (QName, (QName, ([Arg Term], (Dom Type, Term, Type))))))
-> [QName]
-> TCMT
     IO [Maybe (QName, (QName, ([Arg Term], (Dom Type, Term, Type))))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (MaybeT TCM (QName, (QName, ([Arg Term], (Dom Type, Term, Type))))
-> TCMT
     IO (Maybe (QName, (QName, ([Arg Term], (Dom Type, Term, Type)))))
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT TCM (QName, (QName, ([Arg Term], (Dom Type, Term, Type))))
 -> TCMT
      IO (Maybe (QName, (QName, ([Arg Term], (Dom Type, Term, Type))))))
-> (QName
    -> MaybeT
         TCM (QName, (QName, ([Arg Term], (Dom Type, Term, Type)))))
-> QName
-> TCMT
     IO (Maybe (QName, (QName, ([Arg Term], (Dom Type, Term, Type)))))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QName
-> MaybeT
     TCM (QName, (QName, ([Arg Term], (Dom Type, Term, Type))))
try) (NonEmpty QName -> [QName]
forall a. NonEmpty a -> [a]
NonEmpty.toList NonEmpty QName
ds)
      case [[(QName, (QName, ([Arg Term], (Dom Type, Term, Type))))]]
cands of
        [] -> NonEmpty QName -> TCM (Term, Type, CheckedTarget)
forall a. NonEmpty QName -> TCM a
refuseProjNoMatching NonEmpty QName
ds
        [[]] -> NonEmpty QName -> TCM (Term, Type, CheckedTarget)
forall a. NonEmpty QName -> TCM a
refuseProjNoMatching NonEmpty QName
ds
        ([(QName, (QName, ([Arg Term], (Dom Type, Term, Type))))]
_:[(QName, (QName, ([Arg Term], (Dom Type, Term, Type))))]
_:[[(QName, (QName, ([Arg Term], (Dom Type, Term, Type))))]]
_) -> NonEmpty QName -> VerboseKey -> TCM (Term, Type, CheckedTarget)
forall a. NonEmpty QName -> VerboseKey -> TCM a
refuseProj NonEmpty QName
ds (VerboseKey -> TCM (Term, Type, CheckedTarget))
-> VerboseKey -> TCM (Term, Type, CheckedTarget)
forall a b. (a -> b) -> a -> b
$ VerboseKey
"several matching candidates found: "
             VerboseKey -> VerboseKey -> VerboseKey
forall a. [a] -> [a] -> [a]
++ [QName] -> VerboseKey
forall a. Pretty a => a -> VerboseKey
prettyShow (((QName, (QName, ([Arg Term], (Dom Type, Term, Type)))) -> QName)
-> [(QName, (QName, ([Arg Term], (Dom Type, Term, Type))))]
-> [QName]
forall a b. (a -> b) -> [a] -> [b]
map ((QName, ([Arg Term], (Dom Type, Term, Type))) -> QName
forall a b. (a, b) -> a
fst ((QName, ([Arg Term], (Dom Type, Term, Type))) -> QName)
-> ((QName, (QName, ([Arg Term], (Dom Type, Term, Type))))
    -> (QName, ([Arg Term], (Dom Type, Term, Type))))
-> (QName, (QName, ([Arg Term], (Dom Type, Term, Type))))
-> QName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (QName, (QName, ([Arg Term], (Dom Type, Term, Type))))
-> (QName, ([Arg Term], (Dom Type, Term, Type)))
forall a b. (a, b) -> b
snd) ([(QName, (QName, ([Arg Term], (Dom Type, Term, Type))))]
 -> [QName])
-> [(QName, (QName, ([Arg Term], (Dom Type, Term, Type))))]
-> [QName]
forall a b. (a -> b) -> a -> b
$ [[(QName, (QName, ([Arg Term], (Dom Type, Term, Type))))]]
-> [(QName, (QName, ([Arg Term], (Dom Type, Term, Type))))]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[(QName, (QName, ([Arg Term], (Dom Type, Term, Type))))]]
cands)
        -- case: just one matching projection d
        -- the term u = d v
        -- the type tb is the type of this application
        [ (QName
_orig, (QName
d, ([Arg Term]
pars, (Dom Type
_dom,Term
u,Type
tb)))) : [(QName, (QName, ([Arg Term], (Dom Type, Term, Type))))]
_ ] -> do
          QName -> TCMT IO ()
storeDisambiguatedName QName
d

          -- Check parameters
          Type
tfull <- QName -> TCMT IO Type
forall (m :: * -> *).
(HasConstInfo m, ReadTCState m) =>
QName -> m Type
typeOfConst QName
d
          ([Arg Term]
_,Type
_) <- Args -> [Arg Term] -> Type -> TCM ([Arg Term], Type)
checkKnownArguments (VerboseLevel -> Args -> Args
forall a. VerboseLevel -> [a] -> [a]
take VerboseLevel
k Args
args) [Arg Term]
pars Type
tfull

          -- Check remaining arguments
          let r :: Range
r     = Expr -> Range
forall t. HasRange t => t -> Range
getRange Expr
e
              args' :: Args
args' = VerboseLevel -> Args -> Args
forall a. VerboseLevel -> [a] -> [a]
drop (VerboseLevel
k VerboseLevel -> VerboseLevel -> VerboseLevel
forall a. Num a => a -> a -> a
+ VerboseLevel
1) Args
args
          Either
  (MaybeRanges, [Elim' Term], Args, Type)
  (MaybeRanges, [Elim' Term], Type, CheckedTarget)
z <- ExceptT
  (MaybeRanges, [Elim' Term], Args, Type)
  TCM
  (MaybeRanges, [Elim' Term], Type, CheckedTarget)
-> TCM
     (Either
        (MaybeRanges, [Elim' Term], Args, Type)
        (MaybeRanges, [Elim' Term], Type, CheckedTarget))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT
   (MaybeRanges, [Elim' Term], Args, Type)
   TCM
   (MaybeRanges, [Elim' Term], Type, CheckedTarget)
 -> TCM
      (Either
         (MaybeRanges, [Elim' Term], Args, Type)
         (MaybeRanges, [Elim' Term], Type, CheckedTarget)))
-> ExceptT
     (MaybeRanges, [Elim' Term], Args, Type)
     TCM
     (MaybeRanges, [Elim' Term], Type, CheckedTarget)
-> TCM
     (Either
        (MaybeRanges, [Elim' Term], Args, Type)
        (MaybeRanges, [Elim' Term], Type, CheckedTarget))
forall a b. (a -> b) -> a -> b
$ ExpandHidden
-> Range
-> Args
-> Type
-> Maybe Type
-> ExceptT
     (MaybeRanges, [Elim' Term], Args, Type)
     TCM
     (MaybeRanges, [Elim' Term], Type, CheckedTarget)
checkArgumentsE ExpandHidden
ExpandLast Range
r Args
args' Type
tb ((Comparison, Type) -> Type
forall a b. (a, b) -> b
snd ((Comparison, Type) -> Type)
-> Maybe (Comparison, Type) -> Maybe Type
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Comparison, Type)
mt)
          case Either
  (MaybeRanges, [Elim' Term], Args, Type)
  (MaybeRanges, [Elim' Term], Type, CheckedTarget)
z of
            Right (MaybeRanges
rs, [Elim' Term]
us, Type
trest, CheckedTarget
targetCheck) -> (Term, Type, CheckedTarget) -> TCM (Term, Type, CheckedTarget)
forall (m :: * -> *) a. Monad m => a -> m a
return (Term
u Term -> [Elim' Term] -> Term
forall t. Apply t => t -> [Elim' Term] -> t
`applyE` [Elim' Term]
us, Type
trest, CheckedTarget
targetCheck)
            Left (MaybeRanges, [Elim' Term], Args, Type)
problem -> do
              -- In the inference case:
              -- To create a postponed type checking problem,
              -- we do not use typeDontCare, but create a meta.
              Type
tc <- Maybe (Comparison, Type)
-> TCMT IO Type
-> ((Comparison, Type) -> TCMT IO Type)
-> TCMT IO Type
forall a b. Maybe a -> b -> (a -> b) -> b
caseMaybe Maybe (Comparison, Type)
mt TCMT IO Type
newTypeMeta_ (Type -> TCMT IO Type
forall (m :: * -> *) a. Monad m => a -> m a
return (Type -> TCMT IO Type)
-> ((Comparison, Type) -> Type)
-> (Comparison, Type)
-> TCMT IO Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Comparison, Type) -> Type
forall a b. (a, b) -> b
snd)
              Term
v  <- (MaybeRanges, [Elim' Term], Args, Type)
-> ExpandHidden
-> Range
-> Args
-> Type
-> (MaybeRanges
    -> [Elim' Term] -> Type -> CheckedTarget -> TCM Term)
-> TCM Term
postponeArgs (MaybeRanges, [Elim' Term], Args, Type)
problem ExpandHidden
ExpandLast Range
r Args
args' Type
tc ((MaybeRanges -> [Elim' Term] -> Type -> CheckedTarget -> TCM Term)
 -> TCM Term)
-> (MaybeRanges
    -> [Elim' Term] -> Type -> CheckedTarget -> TCM Term)
-> TCM Term
forall a b. (a -> b) -> a -> b
$ \ MaybeRanges
rs [Elim' Term]
us Type
trest CheckedTarget
targetCheck ->
                      Comparison -> CheckedTarget -> Term -> Type -> Type -> TCM Term
coerce' Comparison
cmp CheckedTarget
targetCheck (Term
u Term -> [Elim' Term] -> Term
forall t. Apply t => t -> [Elim' Term] -> t
`applyE` [Elim' Term]
us) Type
trest Type
tc

              (Term, Type, CheckedTarget) -> TCM (Term, Type, CheckedTarget)
forall (m :: * -> *) a. Monad m => a -> m a
return (Term
v, Type
tc, CheckedTarget
NotCheckedTarget)

refuseProj :: NonEmpty QName -> String -> TCM a
refuseProj :: NonEmpty QName -> VerboseKey -> TCM a
refuseProj NonEmpty QName
ds VerboseKey
reason = TypeError -> TCM a
forall (m :: * -> *) a.
(MonadTCEnv m, ReadTCState m, MonadError TCErr m) =>
TypeError -> m a
typeError (TypeError -> TCM a) -> TypeError -> TCM a
forall a b. (a -> b) -> a -> b
$ VerboseKey -> TypeError
GenericError (VerboseKey -> TypeError) -> VerboseKey -> TypeError
forall a b. (a -> b) -> a -> b
$
        VerboseKey
"Cannot resolve overloaded projection "
        VerboseKey -> VerboseKey -> VerboseKey
forall a. [a] -> [a] -> [a]
++ Name -> VerboseKey
forall a. Pretty a => a -> VerboseKey
prettyShow (Name -> Name
A.nameConcrete (Name -> Name) -> Name -> Name
forall a b. (a -> b) -> a -> b
$ QName -> Name
A.qnameName (QName -> Name) -> QName -> Name
forall a b. (a -> b) -> a -> b
$ NonEmpty QName -> QName
forall a. NonEmpty a -> a
NonEmpty.head NonEmpty QName
ds)
        VerboseKey -> VerboseKey -> VerboseKey
forall a. [a] -> [a] -> [a]
++ VerboseKey
" because " VerboseKey -> VerboseKey -> VerboseKey
forall a. [a] -> [a] -> [a]
++ VerboseKey
reason

refuseProjNotApplied, refuseProjNoMatching, refuseProjNotRecordType :: NonEmpty QName -> TCM a
refuseProjNotApplied :: NonEmpty QName -> TCM a
refuseProjNotApplied    NonEmpty QName
ds = NonEmpty QName -> VerboseKey -> TCM a
forall a. NonEmpty QName -> VerboseKey -> TCM a
refuseProj NonEmpty QName
ds VerboseKey
"it is not applied to a visible argument"
refuseProjNoMatching :: NonEmpty QName -> TCM a
refuseProjNoMatching    NonEmpty QName
ds = NonEmpty QName -> VerboseKey -> TCM a
forall a. NonEmpty QName -> VerboseKey -> TCM a
refuseProj NonEmpty QName
ds VerboseKey
"no matching candidate found"
refuseProjNotRecordType :: NonEmpty QName -> TCM a
refuseProjNotRecordType NonEmpty QName
ds = NonEmpty QName -> VerboseKey -> TCM a
forall a. NonEmpty QName -> VerboseKey -> TCM a
refuseProj NonEmpty QName
ds VerboseKey
"principal argument is not of record type"

-----------------------------------------------------------------------------
-- * Coinduction
-----------------------------------------------------------------------------

checkSharpApplication :: A.Expr -> Type -> QName -> [NamedArg A.Expr] -> TCM Term
checkSharpApplication :: Expr -> Type -> QName -> Args -> TCM Term
checkSharpApplication Expr
e Type
t QName
c Args
args = do
  Expr
arg <- case Args
args of
           [NamedArg Expr
a] | NamedArg Expr -> Bool
forall a. LensHiding a => a -> Bool
visible NamedArg Expr
a -> Expr -> TCMT IO Expr
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr -> TCMT IO Expr) -> Expr -> TCMT IO Expr
forall a b. (a -> b) -> a -> b
$ NamedArg Expr -> Expr
forall a. NamedArg a -> a
namedArg NamedArg Expr
a
           Args
_ -> TypeError -> TCMT IO Expr
forall (m :: * -> *) a.
(MonadTCEnv m, ReadTCState m, MonadError TCErr m) =>
TypeError -> m a
typeError (TypeError -> TCMT IO Expr) -> TypeError -> TCMT IO Expr
forall a b. (a -> b) -> a -> b
$ VerboseKey -> TypeError
GenericError (VerboseKey -> TypeError) -> VerboseKey -> TypeError
forall a b. (a -> b) -> a -> b
$ QName -> VerboseKey
forall a. Pretty a => a -> VerboseKey
prettyShow QName
c VerboseKey -> VerboseKey -> VerboseKey
forall a. [a] -> [a] -> [a]
++ VerboseKey
" must be applied to exactly one argument."

  -- The name of the fresh function.
  VerboseLevel
i <- TCMT IO VerboseLevel
forall i (m :: * -> *). MonadFresh i m => m i
fresh :: TCM Int
  let name :: VerboseKey
name = (Char -> Bool) -> VerboseKey -> VerboseKey
forall a. (a -> Bool) -> [a] -> [a]
filter (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'_') (Name -> VerboseKey
forall a. Pretty a => a -> VerboseKey
prettyShow (Name -> VerboseKey) -> Name -> VerboseKey
forall a b. (a -> b) -> a -> b
$ Name -> Name
A.nameConcrete (Name -> Name) -> Name -> Name
forall a b. (a -> b) -> a -> b
$ QName -> Name
A.qnameName QName
c) VerboseKey -> VerboseKey -> VerboseKey
forall a. [a] -> [a] -> [a]
++ VerboseKey
"-" VerboseKey -> VerboseKey -> VerboseKey
forall a. [a] -> [a] -> [a]
++ VerboseLevel -> VerboseKey
forall a. Show a => a -> VerboseKey
show VerboseLevel
i

  CoinductionKit
kit <- TCM CoinductionKit
coinductionKit'
  let flat :: QName
flat = CoinductionKit -> QName
nameOfFlat CoinductionKit
kit
      inf :: QName
inf  = CoinductionKit -> QName
nameOfInf  CoinductionKit
kit

  -- Add the type signature of the fresh function to the
  -- signature.
  -- To make sure we can type check the generated function we have to make
  -- sure that its type is \inf. The reason for this is that we don't yet
  -- postpone checking of patterns when we don't know their types (Issue480).
  Type
forcedType <- do
    Type
lvl <- TCMT IO Type
forall (m :: * -> *). HasBuiltins m => m Type
levelType
    (MetaId
_, Term
l) <- RunMetaOccursCheck -> Comparison -> Type -> TCMT IO (MetaId, Term)
forall (m :: * -> *).
MonadMetaSolver m =>
RunMetaOccursCheck -> Comparison -> Type -> m (MetaId, Term)
newValueMeta RunMetaOccursCheck
RunMetaOccursCheck Comparison
CmpLeq Type
lvl
    Level
lv  <- Term -> TCMT IO Level
forall (m :: * -> *).
(HasBuiltins m, MonadReduce m, MonadDebug m) =>
Term -> m Level
levelView Term
l
    (MetaId
_, Term
a) <- RunMetaOccursCheck -> Comparison -> Type -> TCMT IO (MetaId, Term)
forall (m :: * -> *).
MonadMetaSolver m =>
RunMetaOccursCheck -> Comparison -> Type -> m (MetaId, Term)
newValueMeta RunMetaOccursCheck
RunMetaOccursCheck Comparison
CmpEq (Sort' Term -> Type
sort (Sort' Term -> Type) -> Sort' Term -> Type
forall a b. (a -> b) -> a -> b
$ Level -> Sort' Term
forall t. Level' t -> Sort' t
Type Level
lv)
    Type -> TCMT IO Type
forall (m :: * -> *) a. Monad m => a -> m a
return (Type -> TCMT IO Type) -> Type -> TCMT IO Type
forall a b. (a -> b) -> a -> b
$ Sort' Term -> Term -> Type
forall t a. Sort' t -> a -> Type'' t a
El (Level -> Sort' Term
forall t. Level' t -> Sort' t
Type Level
lv) (Term -> Type) -> Term -> Type
forall a b. (a -> b) -> a -> b
$ QName -> [Elim' Term] -> Term
Def QName
inf [Arg Term -> Elim' Term
forall a. Arg a -> Elim' a
Apply (Arg Term -> Elim' Term) -> Arg Term -> Elim' Term
forall a b. (a -> b) -> a -> b
$ Hiding -> Arg Term -> Arg Term
forall a. LensHiding a => Hiding -> a -> a
setHiding Hiding
Hidden (Arg Term -> Arg Term) -> Arg Term -> Arg Term
forall a b. (a -> b) -> a -> b
$ Term -> Arg Term
forall e. e -> Arg e
defaultArg Term
l, Arg Term -> Elim' Term
forall a. Arg a -> Elim' a
Apply (Arg Term -> Elim' Term) -> Arg Term -> Elim' Term
forall a b. (a -> b) -> a -> b
$ Term -> Arg Term
forall e. e -> Arg e
defaultArg Term
a]

  QName
wrapper <- TCM QName -> TCM QName
forall a. TCM a -> TCM a
inFreshModuleIfFreeParams (TCM QName -> TCM QName) -> TCM QName -> TCM QName
forall a b. (a -> b) -> a -> b
$ (TCEnv -> TCEnv) -> TCM QName -> TCM QName
forall (m :: * -> *) a.
MonadTCEnv m =>
(TCEnv -> TCEnv) -> m a -> m a
localTC (Lens' Quantity TCEnv -> LensSet Quantity TCEnv
forall i o. Lens' i o -> LensSet i o
set Lens' Quantity TCEnv
eQuantity Quantity
topQuantity) (TCM QName -> TCM QName) -> TCM QName -> TCM QName
forall a b. (a -> b) -> a -> b
$ do
    -- Andreas, 2019-10-12: create helper functions in non-erased mode.
    -- Otherwise, they are not usable in meta-solutions in the term world.
    QName
c' <- Range -> QName -> QName
forall t. SetRange t => Range -> t -> t
setRange (QName -> Range
forall t. HasRange t => t -> Range
getRange QName
c) (QName -> QName) -> TCM QName -> TCM QName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
            (ModuleName -> Name -> QName)
-> TCMT IO ModuleName -> TCMT IO Name -> TCM QName
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 ModuleName -> Name -> QName
qualify (KillRangeT ModuleName
forall a. KillRange a => KillRangeT a
killRange KillRangeT ModuleName -> TCMT IO ModuleName -> TCMT IO ModuleName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TCMT IO ModuleName
forall (m :: * -> *). MonadTCEnv m => m ModuleName
currentModule)
                           (VerboseKey -> TCMT IO Name
forall a (m :: * -> *).
(FreshName a, MonadFresh NameId m) =>
a -> m Name
freshName_ VerboseKey
name)

    -- Define and type check the fresh function.
    Modality
mod <- (TCEnv -> Modality) -> TCMT IO Modality
forall (m :: * -> *) a. MonadTCEnv m => (TCEnv -> a) -> m a
asksTC TCEnv -> Modality
forall a. LensModality a => a -> Modality
getModality
    IsAbstract
abs <- (TCEnv -> IsAbstract) -> TCMT IO IsAbstract
forall (m :: * -> *) a. MonadTCEnv m => (TCEnv -> a) -> m a
asksTC (TCEnv -> Lens' IsAbstract TCEnv -> IsAbstract
forall o i. o -> Lens' i o -> i
^. forall a. LensIsAbstract a => Lens' IsAbstract a
Lens' IsAbstract TCEnv
lensIsAbstract)
    let info :: DefInfo' t
info   = Name -> Fixity' -> Access -> IsAbstract -> Range -> DefInfo' t
forall t.
Name -> Fixity' -> Access -> IsAbstract -> Range -> DefInfo' t
A.mkDefInfo (Name -> Name
A.nameConcrete (Name -> Name) -> Name -> Name
forall a b. (a -> b) -> a -> b
$ QName -> Name
A.qnameName QName
c') Fixity'
noFixity'
                             Access
PublicAccess IsAbstract
abs Range
forall a. Range' a
noRange
        core :: LHSCore' e
core   = LHSProj :: forall e.
AmbiguousQName
-> NamedArg (LHSCore' e) -> [NamedArg (Pattern' e)] -> LHSCore' e
A.LHSProj { lhsDestructor :: AmbiguousQName
A.lhsDestructor = QName -> AmbiguousQName
unambiguous QName
flat
                           , lhsFocus :: NamedArg (LHSCore' e)
A.lhsFocus      = LHSCore' e -> NamedArg (LHSCore' e)
forall a. a -> NamedArg a
defaultNamedArg (LHSCore' e -> NamedArg (LHSCore' e))
-> LHSCore' e -> NamedArg (LHSCore' e)
forall a b. (a -> b) -> a -> b
$ QName -> [NamedArg (Pattern' e)] -> LHSCore' e
forall e. QName -> [NamedArg (Pattern' e)] -> LHSCore' e
A.LHSHead QName
c' []
                           , lhsPats :: [NamedArg (Pattern' e)]
A.lhsPats       = [] }
        clause :: Clause' LHS
clause = LHS
-> [ProblemEq] -> RHS -> WhereDeclarations -> Bool -> Clause' LHS
forall lhs.
lhs
-> [ProblemEq] -> RHS -> WhereDeclarations -> Bool -> Clause' lhs
A.Clause (LHSInfo -> LHSCore -> LHS
A.LHS LHSInfo
forall a. Null a => a
empty LHSCore
forall e. LHSCore' e
core) []
                          (Expr -> Maybe Expr -> RHS
A.RHS Expr
arg Maybe Expr
forall a. Maybe a
Nothing)
                          WhereDeclarations
A.noWhereDecls Bool
False

    MutualId
i <- TCM MutualId
currentOrFreshMutualBlock

    -- If we are in irrelevant position, add definition irrelevantly.
    -- If we are in erased position, add definition as erased.
    -- TODO: is this sufficient?
    QName -> Definition -> TCMT IO ()
addConstant QName
c' (Definition -> TCMT IO ()) -> TCMT IO Definition -> TCMT IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< do
      let ai :: ArgInfo
ai = Modality -> ArgInfo -> ArgInfo
forall a. LensModality a => Modality -> a -> a
setModality Modality
mod ArgInfo
defaultArgInfo
      Definition -> TCMT IO Definition
useTerPragma (Definition -> TCMT IO Definition)
-> Definition -> TCMT IO Definition
forall a b. (a -> b) -> a -> b
$
        (ArgInfo -> QName -> Type -> Defn -> Definition
defaultDefn ArgInfo
ai QName
c' Type
forcedType Defn
emptyFunction)
        { defMutual :: MutualId
defMutual = MutualId
i }

    Delayed -> DefInfo -> QName -> [Clause' LHS] -> TCMT IO ()
checkFunDef Delayed
NotDelayed DefInfo
forall t. DefInfo' t
info QName
c' [Clause' LHS
clause]

    VerboseKey -> VerboseLevel -> TCM Doc -> TCMT IO ()
forall (m :: * -> *).
MonadDebug m =>
VerboseKey -> VerboseLevel -> TCM Doc -> m ()
reportSDoc VerboseKey
"tc.term.expr.coind" VerboseLevel
15 (TCM Doc -> TCMT IO ()) -> TCM Doc -> TCMT IO ()
forall a b. (a -> b) -> a -> b
$ do
      Defn
def <- Definition -> Defn
theDef (Definition -> Defn) -> TCMT IO Definition -> TCMT IO Defn
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> QName -> TCMT IO Definition
forall (m :: * -> *). HasConstInfo m => QName -> m Definition
getConstInfo QName
c'
      [TCM Doc] -> TCM Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
vcat ([TCM Doc] -> TCM Doc) -> [TCM Doc] -> TCM Doc
forall a b. (a -> b) -> a -> b
$
        [ TCM Doc
"The coinductive wrapper"
        , VerboseLevel -> TCM Doc -> TCM Doc
forall (m :: * -> *). Functor m => VerboseLevel -> m Doc -> m Doc
nest VerboseLevel
2 (TCM Doc -> TCM Doc) -> TCM Doc -> TCM Doc
forall a b. (a -> b) -> a -> b
$ Modality -> TCM Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM Modality
mod TCM Doc -> TCM Doc -> TCM Doc
forall a. Semigroup a => a -> a -> a
<> (QName -> TCM Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM QName
c' TCM Doc -> TCM Doc -> TCM Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> TCM Doc
":")
        , VerboseLevel -> TCM Doc -> TCM Doc
forall (m :: * -> *). Functor m => VerboseLevel -> m Doc -> m Doc
nest VerboseLevel
4 (TCM Doc -> TCM Doc) -> TCM Doc -> TCM Doc
forall a b. (a -> b) -> a -> b
$ Type -> TCM Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM Type
t
        , VerboseLevel -> TCM Doc -> TCM Doc
forall (m :: * -> *). Functor m => VerboseLevel -> m Doc -> m Doc
nest VerboseLevel
2 (TCM Doc -> TCM Doc) -> TCM Doc -> TCM Doc
forall a b. (a -> b) -> a -> b
$ Clause' LHS -> TCM Doc
forall c a (m :: * -> *).
(Pretty c, ToConcrete a c, MonadAbsToCon m) =>
a -> m Doc
prettyA Clause' LHS
clause
        , (TCM Doc
"The definition is" TCM Doc -> TCM Doc -> TCM Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> VerboseKey -> TCM Doc
forall (m :: * -> *). Monad m => VerboseKey -> m Doc
text (Delayed -> VerboseKey
forall a. Show a => a -> VerboseKey
show (Delayed -> VerboseKey) -> Delayed -> VerboseKey
forall a b. (a -> b) -> a -> b
$ Defn -> Delayed
funDelayed Defn
def)) TCM Doc -> TCM Doc -> TCM Doc
forall a. Semigroup a => a -> a -> a
<>
          TCM Doc
"."
        ]
    QName -> TCM QName
forall (m :: * -> *) a. Monad m => a -> m a
return QName
c'

  -- The application of the fresh function to the relevant
  -- arguments.
  Term
e' <- QName -> [Elim' Term] -> Term
Def QName
wrapper ([Elim' Term] -> Term)
-> ([Arg Term] -> [Elim' Term]) -> [Arg Term] -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Arg Term -> Elim' Term) -> [Arg Term] -> [Elim' Term]
forall a b. (a -> b) -> [a] -> [b]
map Arg Term -> Elim' Term
forall a. Arg a -> Elim' a
Apply ([Arg Term] -> Term) -> TCMT IO [Arg Term] -> TCM Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TCMT IO [Arg Term]
forall (m :: * -> *). (Applicative m, MonadTCEnv m) => m [Arg Term]
getContextArgs

  VerboseKey -> VerboseLevel -> TCM Doc -> TCMT IO ()
forall (m :: * -> *).
MonadDebug m =>
VerboseKey -> VerboseLevel -> TCM Doc -> m ()
reportSDoc VerboseKey
"tc.term.expr.coind" VerboseLevel
15 (TCM Doc -> TCMT IO ()) -> TCM Doc -> TCMT IO ()
forall a b. (a -> b) -> a -> b
$ [TCM Doc] -> TCM Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
vcat ([TCM Doc] -> TCM Doc) -> [TCM Doc] -> TCM Doc
forall a b. (a -> b) -> a -> b
$
      [ TCM Doc
"The coinductive constructor application"
      , VerboseLevel -> TCM Doc -> TCM Doc
forall (m :: * -> *). Functor m => VerboseLevel -> m Doc -> m Doc
nest VerboseLevel
2 (TCM Doc -> TCM Doc) -> TCM Doc -> TCM Doc
forall a b. (a -> b) -> a -> b
$ Expr -> TCM Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM Expr
e
      , TCM Doc
"was translated into the application"
      , VerboseLevel -> TCM Doc -> TCM Doc
forall (m :: * -> *). Functor m => VerboseLevel -> m Doc -> m Doc
nest VerboseLevel
2 (TCM Doc -> TCM Doc) -> TCM Doc -> TCM Doc
forall a b. (a -> b) -> a -> b
$ Term -> TCM Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM Term
e'
      ]

  Type -> TCM Term -> TCM Term
forall (m :: * -> *).
(MonadMetaSolver m, MonadConstraint m, MonadFresh VerboseLevel m,
 MonadFresh ProblemId m) =>
Type -> m Term -> m Term
blockTerm Type
t (TCM Term -> TCM Term) -> TCM Term -> TCM Term
forall a b. (a -> b) -> a -> b
$ Term
e' Term -> TCMT IO () -> TCM Term
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ TCMT IO () -> TCMT IO ()
forall (m :: * -> *) a.
(MonadTCEnv m, HasOptions m, MonadDebug m) =>
m a -> m a
workOnTypes (Type -> Type -> TCMT IO ()
forall (m :: * -> *). MonadConversion m => Type -> Type -> m ()
leqType Type
forcedType Type
t)

-----------------------------------------------------------------------------
-- * Cubical
-----------------------------------------------------------------------------

-- | "pathAbs (PathView s _ l a x y) t" builds "(\ t) : pv"
--   Preconditions: PathView is PathType, and t[i0] = x, t[i1] = y
pathAbs :: PathView -> Abs Term -> TCM Term
pathAbs :: PathView -> Abs Term -> TCM Term
pathAbs (OType Type
_) Abs Term
t = TCM Term
forall a. HasCallStack => a
__IMPOSSIBLE__
pathAbs (PathType Sort' Term
s QName
path Arg Term
l Arg Term
a Arg Term
x Arg Term
y) Abs Term
t = do
  Term -> TCM Term
forall (m :: * -> *) a. Monad m => a -> m a
return (Term -> TCM Term) -> Term -> TCM Term
forall a b. (a -> b) -> a -> b
$ ArgInfo -> Abs Term -> Term
Lam ArgInfo
defaultArgInfo Abs Term
t

-- | @primComp : ∀ {ℓ} (A : (i : I) → Set (ℓ i)) (φ : I) (u : ∀ i → Partial φ (A i)) (a : A i0) → A i1@
--
--   Check:  @u i0 = (λ _ → a) : Partial φ (A i0)@.
--
checkPrimComp :: QName -> MaybeRanges -> Args -> Type -> TCM Args
checkPrimComp :: QName -> MaybeRanges -> [Arg Term] -> Type -> TCMT IO [Arg Term]
checkPrimComp QName
c MaybeRanges
rs [Arg Term]
vs Type
_ = do
  case [Arg Term]
vs of
    -- WAS: [l, a, phi, u, a0] -> do
    Arg Term
l : Arg Term
a : Arg Term
phi : Arg Term
u : Arg Term
a0 : [Arg Term]
rest -> do
      Arg Term
iz <- ArgInfo -> Term -> Arg Term
forall e. ArgInfo -> e -> Arg e
Arg ArgInfo
defaultArgInfo (Term -> Arg Term) -> TCM Term -> TCMT IO (Arg Term)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IntervalView -> TCM Term
forall (m :: * -> *). HasBuiltins m => IntervalView -> m Term
intervalUnview IntervalView
IZero
      let lz :: Term
lz = Arg Term -> Term
forall e. Arg e -> e
unArg Arg Term
l Term -> [Arg Term] -> Term
forall t. Apply t => t -> [Arg Term] -> t
`apply` [Arg Term
iz]
          az :: Term
az = Arg Term -> Term
forall e. Arg e -> e
unArg Arg Term
a Term -> [Arg Term] -> Term
forall t. Apply t => t -> [Arg Term] -> t
`apply` [Arg Term
iz]
      Type
ty <- TCM Term -> TCMT IO Type
forall (m :: * -> *). Functor m => m Term -> m Type
elInf (TCM Term -> TCMT IO Type) -> TCM Term -> TCMT IO Type
forall a b. (a -> b) -> a -> b
$ TCM Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primPartial TCM Term -> TCM Term -> TCM Term
forall (tcm :: * -> *).
Monad tcm =>
tcm Term -> tcm Term -> tcm Term
<#> (Term -> TCM Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term -> TCM Term) -> Term -> TCM Term
forall a b. (a -> b) -> a -> b
$ Arg Term -> Term
forall e. Arg e -> e
unArg Arg Term
l Term -> [Arg Term] -> Term
forall t. Apply t => t -> [Arg Term] -> t
`apply` [Arg Term
iz]) TCM Term -> TCM Term -> TCM Term
forall (tcm :: * -> *).
Monad tcm =>
tcm Term -> tcm Term -> tcm Term
<@> (Term -> TCM Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term -> TCM Term) -> Term -> TCM Term
forall a b. (a -> b) -> a -> b
$ Arg Term -> Term
forall e. Arg e -> e
unArg Arg Term
phi) TCM Term -> TCM Term -> TCM Term
forall (tcm :: * -> *).
Monad tcm =>
tcm Term -> tcm Term -> tcm Term
<@> (Term -> TCM Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term -> TCM Term) -> Term -> TCM Term
forall a b. (a -> b) -> a -> b
$ Arg Term -> Term
forall e. Arg e -> e
unArg Arg Term
a Term -> [Arg Term] -> Term
forall t. Apply t => t -> [Arg Term] -> t
`apply` [Arg Term
iz])
      Type
bAz <- TCM Term -> TCM Term -> TCMT IO Type
forall (m :: * -> *). Monad m => m Term -> m Term -> m Type
el' (Term -> TCM Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term -> TCM Term) -> Term -> TCM Term
forall a b. (a -> b) -> a -> b
$ Term
lz) (Term -> TCM Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term -> TCM Term) -> Term -> TCM Term
forall a b. (a -> b) -> a -> b
$ Term
az)
      Arg Term
a0 <- Type
-> Maybe (Maybe Range)
-> Arg Term
-> TCMT IO ()
-> TCMT IO (Arg Term)
forall r.
HasRange r =>
Type -> r -> Arg Term -> TCMT IO () -> TCMT IO (Arg Term)
blockArg Type
bAz (MaybeRanges
rs MaybeRanges -> VerboseLevel -> Maybe (Maybe Range)
forall a. [a] -> VerboseLevel -> Maybe a
!!! VerboseLevel
4) Arg Term
a0 (TCMT IO () -> TCMT IO (Arg Term))
-> TCMT IO () -> TCMT IO (Arg Term)
forall a b. (a -> b) -> a -> b
$ do
        Type -> Term -> Term -> TCMT IO ()
forall (m :: * -> *).
MonadConversion m =>
Type -> Term -> Term -> m ()
equalTerm Type
ty -- (El (getSort t1) (apply (unArg a) [iz]))
          (ArgInfo -> Abs Term -> Term
Lam ArgInfo
defaultArgInfo (Abs Term -> Term) -> Abs Term -> Term
forall a b. (a -> b) -> a -> b
$ VerboseKey -> Term -> Abs Term
forall a. VerboseKey -> a -> Abs a
NoAbs VerboseKey
"_" (Term -> Abs Term) -> Term -> Abs Term
forall a b. (a -> b) -> a -> b
$ Arg Term -> Term
forall e. Arg e -> e
unArg Arg Term
a0)
          (Term -> [Arg Term] -> Term
forall t. Apply t => t -> [Arg Term] -> t
apply (Arg Term -> Term
forall e. Arg e -> e
unArg Arg Term
u) [Arg Term
iz])
      [Arg Term] -> TCMT IO [Arg Term]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Arg Term] -> TCMT IO [Arg Term])
-> [Arg Term] -> TCMT IO [Arg Term]
forall a b. (a -> b) -> a -> b
$ Arg Term
l Arg Term -> [Arg Term] -> [Arg Term]
forall a. a -> [a] -> [a]
: Arg Term
a Arg Term -> [Arg Term] -> [Arg Term]
forall a. a -> [a] -> [a]
: Arg Term
phi Arg Term -> [Arg Term] -> [Arg Term]
forall a. a -> [a] -> [a]
: Arg Term
u Arg Term -> [Arg Term] -> [Arg Term]
forall a. a -> [a] -> [a]
: Arg Term
a0 Arg Term -> [Arg Term] -> [Arg Term]
forall a. a -> [a] -> [a]
: [Arg Term]
rest
    [Arg Term]
_ -> TypeError -> TCMT IO [Arg Term]
forall (m :: * -> *) a.
(MonadTCEnv m, ReadTCState m, MonadError TCErr m) =>
TypeError -> m a
typeError (TypeError -> TCMT IO [Arg Term])
-> TypeError -> TCMT IO [Arg Term]
forall a b. (a -> b) -> a -> b
$ VerboseKey -> TypeError
GenericError (VerboseKey -> TypeError) -> VerboseKey -> TypeError
forall a b. (a -> b) -> a -> b
$ QName -> VerboseKey
forall a. Show a => a -> VerboseKey
show QName
c VerboseKey -> VerboseKey -> VerboseKey
forall a. [a] -> [a] -> [a]
++ VerboseKey
" must be fully applied"

-- | @primHComp : ∀ {ℓ} {A : Set ℓ} {φ : I} (u : ∀ i → Partial φ A) (a : A) → A@
--
--   Check:  @u i0 = (λ _ → a) : Partial φ A@.
--
checkPrimHComp :: QName -> MaybeRanges -> Args -> Type -> TCM Args
checkPrimHComp :: QName -> MaybeRanges -> [Arg Term] -> Type -> TCMT IO [Arg Term]
checkPrimHComp QName
c MaybeRanges
rs [Arg Term]
vs Type
_ = do
  case [Arg Term]
vs of
    -- WAS: [l, a, phi, u, a0] -> do
    Arg Term
l : Arg Term
a : Arg Term
phi : Arg Term
u : Arg Term
a0 : [Arg Term]
rest -> do
      -- iz = i0
      Arg Term
iz <- ArgInfo -> Term -> Arg Term
forall e. ArgInfo -> e -> Arg e
Arg ArgInfo
defaultArgInfo (Term -> Arg Term) -> TCM Term -> TCMT IO (Arg Term)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IntervalView -> TCM Term
forall (m :: * -> *). HasBuiltins m => IntervalView -> m Term
intervalUnview IntervalView
IZero
      -- ty = Partial φ A
      Type
ty <- TCM Term -> TCMT IO Type
forall (m :: * -> *). Functor m => m Term -> m Type
elInf (TCM Term -> TCMT IO Type) -> TCM Term -> TCMT IO Type
forall a b. (a -> b) -> a -> b
$ TCM Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primPartial TCM Term -> TCM Term -> TCM Term
forall (tcm :: * -> *).
Monad tcm =>
tcm Term -> tcm Term -> tcm Term
<#> (Term -> TCM Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term -> TCM Term) -> Term -> TCM Term
forall a b. (a -> b) -> a -> b
$ Arg Term -> Term
forall e. Arg e -> e
unArg Arg Term
l) TCM Term -> TCM Term -> TCM Term
forall (tcm :: * -> *).
Monad tcm =>
tcm Term -> tcm Term -> tcm Term
<@> (Term -> TCM Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term -> TCM Term) -> Term -> TCM Term
forall a b. (a -> b) -> a -> b
$ Arg Term -> Term
forall e. Arg e -> e
unArg Arg Term
phi) TCM Term -> TCM Term -> TCM Term
forall (tcm :: * -> *).
Monad tcm =>
tcm Term -> tcm Term -> tcm Term
<@> (Term -> TCM Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term -> TCM Term) -> Term -> TCM Term
forall a b. (a -> b) -> a -> b
$ Arg Term -> Term
forall e. Arg e -> e
unArg Arg Term
a)
      -- (λ _ → a) = u i0 : ty
      Type
bA <- TCM Term -> TCM Term -> TCMT IO Type
forall (m :: * -> *). Monad m => m Term -> m Term -> m Type
el' (Term -> TCM Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term -> TCM Term) -> Term -> TCM Term
forall a b. (a -> b) -> a -> b
$ Arg Term -> Term
forall e. Arg e -> e
unArg Arg Term
l) (Term -> TCM Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term -> TCM Term) -> Term -> TCM Term
forall a b. (a -> b) -> a -> b
$ Arg Term -> Term
forall e. Arg e -> e
unArg Arg Term
a)
      Arg Term
a0 <- Type
-> Maybe (Maybe Range)
-> Arg Term
-> TCMT IO ()
-> TCMT IO (Arg Term)
forall r.
HasRange r =>
Type -> r -> Arg Term -> TCMT IO () -> TCMT IO (Arg Term)
blockArg Type
bA (MaybeRanges
rs MaybeRanges -> VerboseLevel -> Maybe (Maybe Range)
forall a. [a] -> VerboseLevel -> Maybe a
!!! VerboseLevel
4) Arg Term
a0 (TCMT IO () -> TCMT IO (Arg Term))
-> TCMT IO () -> TCMT IO (Arg Term)
forall a b. (a -> b) -> a -> b
$ do
        Type -> Term -> Term -> TCMT IO ()
forall (m :: * -> *).
MonadConversion m =>
Type -> Term -> Term -> m ()
equalTerm Type
ty -- (El (getSort t1) (apply (unArg a) [iz]))
            (ArgInfo -> Abs Term -> Term
Lam ArgInfo
defaultArgInfo (Abs Term -> Term) -> Abs Term -> Term
forall a b. (a -> b) -> a -> b
$ VerboseKey -> Term -> Abs Term
forall a. VerboseKey -> a -> Abs a
NoAbs VerboseKey
"_" (Term -> Abs Term) -> Term -> Abs Term
forall a b. (a -> b) -> a -> b
$ Arg Term -> Term
forall e. Arg e -> e
unArg Arg Term
a0)
            (Term -> [Arg Term] -> Term
forall t. Apply t => t -> [Arg Term] -> t
apply (Arg Term -> Term
forall e. Arg e -> e
unArg Arg Term
u) [Arg Term
iz])
      [Arg Term] -> TCMT IO [Arg Term]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Arg Term] -> TCMT IO [Arg Term])
-> [Arg Term] -> TCMT IO [Arg Term]
forall a b. (a -> b) -> a -> b
$ Arg Term
l Arg Term -> [Arg Term] -> [Arg Term]
forall a. a -> [a] -> [a]
: Arg Term
a Arg Term -> [Arg Term] -> [Arg Term]
forall a. a -> [a] -> [a]
: Arg Term
phi Arg Term -> [Arg Term] -> [Arg Term]
forall a. a -> [a] -> [a]
: Arg Term
u Arg Term -> [Arg Term] -> [Arg Term]
forall a. a -> [a] -> [a]
: Arg Term
a0 Arg Term -> [Arg Term] -> [Arg Term]
forall a. a -> [a] -> [a]
: [Arg Term]
rest
    [Arg Term]
_ -> TypeError -> TCMT IO [Arg Term]
forall (m :: * -> *) a.
(MonadTCEnv m, ReadTCState m, MonadError TCErr m) =>
TypeError -> m a
typeError (TypeError -> TCMT IO [Arg Term])
-> TypeError -> TCMT IO [Arg Term]
forall a b. (a -> b) -> a -> b
$ VerboseKey -> TypeError
GenericError (VerboseKey -> TypeError) -> VerboseKey -> TypeError
forall a b. (a -> b) -> a -> b
$ QName -> VerboseKey
forall a. Show a => a -> VerboseKey
show QName
c VerboseKey -> VerboseKey -> VerboseKey
forall a. [a] -> [a] -> [a]
++ VerboseKey
" must be fully applied"

-- | @transp : ∀{ℓ} (A : (i : I) → Set (ℓ i)) (φ : I) (a0 : A i0) → A i1@
--
--   Check:  If φ, then @A i = A i0 : Set (ℓ i)@ must hold for all @i : I@.
--
checkPrimTrans :: QName -> MaybeRanges -> Args -> Type -> TCM Args
checkPrimTrans :: QName -> MaybeRanges -> [Arg Term] -> Type -> TCMT IO [Arg Term]
checkPrimTrans QName
c MaybeRanges
rs [Arg Term]
vs Type
_ = do
  case [Arg Term]
vs of
    -- Andreas, 2019-03-02, issue #3601, why exactly 4 arguments?
    -- Only 3 are needed to check the side condition.
    -- WAS:
    -- [l, a, phi, a0] -> do
    Arg Term
l : Arg Term
a : Arg Term
phi : [Arg Term]
rest -> do
      Arg Term
iz <- ArgInfo -> Term -> Arg Term
forall e. ArgInfo -> e -> Arg e
Arg ArgInfo
defaultArgInfo (Term -> Arg Term) -> TCM Term -> TCMT IO (Arg Term)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IntervalView -> TCM Term
forall (m :: * -> *). HasBuiltins m => IntervalView -> m Term
intervalUnview IntervalView
IZero
      -- ty = (i : I) -> Set (l i)
      Type
ty <- [VerboseKey] -> NamesT TCM Type -> TCMT IO Type
forall (m :: * -> *) a. [VerboseKey] -> NamesT m a -> m a
runNamesT [] (NamesT TCM Type -> TCMT IO Type)
-> NamesT TCM Type -> TCMT IO Type
forall a b. (a -> b) -> a -> b
$ do
        NamesT TCM Term
l <- Term -> NamesT TCM (NamesT TCM Term)
forall (m :: * -> *) t a.
(MonadFail m, Subst t a) =>
a -> NamesT m (NamesT m a)
open (Term -> NamesT TCM (NamesT TCM Term))
-> Term -> NamesT TCM (NamesT TCM Term)
forall a b. (a -> b) -> a -> b
$ Arg Term -> Term
forall e. Arg e -> e
unArg Arg Term
l
        VerboseKey
-> NamesT TCM Type
-> (NamesT TCM Term -> NamesT TCM Type)
-> NamesT TCM Type
forall (m :: * -> *).
(MonadFail m, MonadAddContext m, MonadDebug m) =>
VerboseKey
-> NamesT m Type
-> (NamesT m Term -> NamesT m Type)
-> NamesT m Type
nPi' VerboseKey
"i" (NamesT TCM Term -> NamesT TCM Type
forall (m :: * -> *). Functor m => m Term -> m Type
elInf (NamesT TCM Term -> NamesT TCM Type)
-> NamesT TCM Term -> NamesT TCM Type
forall a b. (a -> b) -> a -> b
$ TCM Term -> NamesT TCM Term
forall (m :: * -> *) a. Monad m => m a -> NamesT m a
cl TCM Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primInterval) ((NamesT TCM Term -> NamesT TCM Type) -> NamesT TCM Type)
-> (NamesT TCM Term -> NamesT TCM Type) -> NamesT TCM Type
forall a b. (a -> b) -> a -> b
$ \ NamesT TCM Term
i -> (Sort' Term -> Type
sort (Sort' Term -> Type) -> (Term -> Sort' Term) -> Term -> Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term -> Sort' Term
tmSort (Term -> Type) -> NamesT TCM Term -> NamesT TCM Type
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (NamesT TCM Term
l NamesT TCM Term -> NamesT TCM Term -> NamesT TCM Term
forall (tcm :: * -> *).
Monad tcm =>
tcm Term -> tcm Term -> tcm Term
<@> NamesT TCM Term
i))
      Arg Term
a <- Type
-> Maybe (Maybe Range)
-> Arg Term
-> TCMT IO ()
-> TCMT IO (Arg Term)
forall r.
HasRange r =>
Type -> r -> Arg Term -> TCMT IO () -> TCMT IO (Arg Term)
blockArg Type
ty (MaybeRanges
rs MaybeRanges -> VerboseLevel -> Maybe (Maybe Range)
forall a. [a] -> VerboseLevel -> Maybe a
!!! VerboseLevel
1) Arg Term
a (TCMT IO () -> TCMT IO (Arg Term))
-> TCMT IO () -> TCMT IO (Arg Term)
forall a b. (a -> b) -> a -> b
$ do
        Term -> Type -> Term -> Term -> TCMT IO ()
forall (m :: * -> *).
MonadConversion m =>
Term -> Type -> Term -> Term -> m ()
equalTermOnFace (Arg Term -> Term
forall e. Arg e -> e
unArg Arg Term
phi) Type
ty
          (Arg Term -> Term
forall e. Arg e -> e
unArg Arg Term
a)
          (ArgInfo -> Abs Term -> Term
Lam ArgInfo
defaultArgInfo (Abs Term -> Term) -> Abs Term -> Term
forall a b. (a -> b) -> a -> b
$ VerboseKey -> Term -> Abs Term
forall a. VerboseKey -> a -> Abs a
NoAbs VerboseKey
"_" (Term -> Abs Term) -> Term -> Abs Term
forall a b. (a -> b) -> a -> b
$ Term -> [Arg Term] -> Term
forall t. Apply t => t -> [Arg Term] -> t
apply (Arg Term -> Term
forall e. Arg e -> e
unArg Arg Term
a) [Arg Term
iz])
      [Arg Term] -> TCMT IO [Arg Term]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Arg Term] -> TCMT IO [Arg Term])
-> [Arg Term] -> TCMT IO [Arg Term]
forall a b. (a -> b) -> a -> b
$ Arg Term
l Arg Term -> [Arg Term] -> [Arg Term]
forall a. a -> [a] -> [a]
: Arg Term
a Arg Term -> [Arg Term] -> [Arg Term]
forall a. a -> [a] -> [a]
: Arg Term
phi Arg Term -> [Arg Term] -> [Arg Term]
forall a. a -> [a] -> [a]
: [Arg Term]
rest
    [Arg Term]
_ -> TypeError -> TCMT IO [Arg Term]
forall (m :: * -> *) a.
(MonadTCEnv m, ReadTCState m, MonadError TCErr m) =>
TypeError -> m a
typeError (TypeError -> TCMT IO [Arg Term])
-> TypeError -> TCMT IO [Arg Term]
forall a b. (a -> b) -> a -> b
$ VerboseKey -> TypeError
GenericError (VerboseKey -> TypeError) -> VerboseKey -> TypeError
forall a b. (a -> b) -> a -> b
$ QName -> VerboseKey
forall a. Show a => a -> VerboseKey
show QName
c VerboseKey -> VerboseKey -> VerboseKey
forall a. [a] -> [a] -> [a]
++ VerboseKey
" must be fully applied"

blockArg :: HasRange r => Type -> r -> Arg Term -> TCM () -> TCM (Arg Term)
blockArg :: Type -> r -> Arg Term -> TCMT IO () -> TCMT IO (Arg Term)
blockArg Type
t r
r Arg Term
a TCMT IO ()
m =
  Range -> TCMT IO (Arg Term) -> TCMT IO (Arg Term)
forall (tcm :: * -> *) x a.
(MonadTCM tcm, ReadTCState tcm, MonadDebug tcm, HasRange x) =>
x -> tcm a -> tcm a
setCurrentRange (r -> Range
forall t. HasRange t => t -> Range
getRange (r -> Range) -> r -> Range
forall a b. (a -> b) -> a -> b
$ r
r) (TCMT IO (Arg Term) -> TCMT IO (Arg Term))
-> TCMT IO (Arg Term) -> TCMT IO (Arg Term)
forall a b. (a -> b) -> a -> b
$ (Term -> Arg Term) -> TCM Term -> TCMT IO (Arg Term)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Arg Term
a Arg Term -> Term -> Arg Term
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$>) (TCM Term -> TCMT IO (Arg Term)) -> TCM Term -> TCMT IO (Arg Term)
forall a b. (a -> b) -> a -> b
$ Type -> TCM Term -> TCM Term
forall (m :: * -> *).
(MonadMetaSolver m, MonadConstraint m, MonadFresh VerboseLevel m,
 MonadFresh ProblemId m) =>
Type -> m Term -> m Term
blockTerm Type
t (TCM Term -> TCM Term) -> TCM Term -> TCM Term
forall a b. (a -> b) -> a -> b
$ TCMT IO ()
m TCMT IO () -> TCM Term -> TCM Term
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Term -> TCM Term
forall (m :: * -> *) a. Monad m => a -> m a
return (Arg Term -> Term
forall e. Arg e -> e
unArg Arg Term
a)

checkConId :: QName -> MaybeRanges -> Args -> Type -> TCM Args
checkConId :: QName -> MaybeRanges -> [Arg Term] -> Type -> TCMT IO [Arg Term]
checkConId QName
c MaybeRanges
rs [Arg Term]
vs Type
t1 = do
  case [Arg Term]
vs of
   args :: [Arg Term]
args@[Arg Term
_, Arg Term
_, Arg Term
_, Arg Term
_, Arg Term
phi, Arg Term
p] -> do
      iv :: PathView
iv@(PathType Sort' Term
s QName
_ Arg Term
l Arg Term
a Arg Term
x Arg Term
y) <- Type -> TCMT IO PathView
forall (m :: * -> *). HasBuiltins m => Type -> m PathView
idViewAsPath Type
t1
      let ty :: Type
ty = PathView -> Type
pathUnview PathView
iv
      -- the following duplicates reduction of phi
      Term
const_x <- Type -> TCM Term -> TCM Term
forall (m :: * -> *).
(MonadMetaSolver m, MonadConstraint m, MonadFresh VerboseLevel m,
 MonadFresh ProblemId m) =>
Type -> m Term -> m Term
blockTerm Type
ty (TCM Term -> TCM Term) -> TCM Term -> TCM Term
forall a b. (a -> b) -> a -> b
$ do
          Term -> Type -> Term -> Term -> TCMT IO ()
forall (m :: * -> *).
MonadConversion m =>
Term -> Type -> Term -> Term -> m ()
equalTermOnFace (Arg Term -> Term
forall e. Arg e -> e
unArg Arg Term
phi) (Sort' Term -> Term -> Type
forall t a. Sort' t -> a -> Type'' t a
El Sort' Term
s (Arg Term -> Term
forall e. Arg e -> e
unArg Arg Term
a)) (Arg Term -> Term
forall e. Arg e -> e
unArg Arg Term
x) (Arg Term -> Term
forall e. Arg e -> e
unArg Arg Term
y)
          PathView -> Abs Term -> TCM Term
pathAbs PathView
iv (VerboseKey -> Term -> Abs Term
forall a. VerboseKey -> a -> Abs a
NoAbs (VerboseKey -> VerboseKey
stringToArgName VerboseKey
"_") (Arg Term -> Term
forall e. Arg e -> e
unArg Arg Term
x))
      Arg Term
p <- Type
-> Maybe (Maybe Range)
-> Arg Term
-> TCMT IO ()
-> TCMT IO (Arg Term)
forall r.
HasRange r =>
Type -> r -> Arg Term -> TCMT IO () -> TCMT IO (Arg Term)
blockArg Type
ty (MaybeRanges
rs MaybeRanges -> VerboseLevel -> Maybe (Maybe Range)
forall a. [a] -> VerboseLevel -> Maybe a
!!! VerboseLevel
5) Arg Term
p (TCMT IO () -> TCMT IO (Arg Term))
-> TCMT IO () -> TCMT IO (Arg Term)
forall a b. (a -> b) -> a -> b
$ do
        Term -> Type -> Term -> Term -> TCMT IO ()
forall (m :: * -> *).
MonadConversion m =>
Term -> Type -> Term -> Term -> m ()
equalTermOnFace (Arg Term -> Term
forall e. Arg e -> e
unArg Arg Term
phi) Type
ty (Arg Term -> Term
forall e. Arg e -> e
unArg Arg Term
p) Term
const_x   -- G, phi |- p = \ i . x
      [Arg Term] -> TCMT IO [Arg Term]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Arg Term] -> TCMT IO [Arg Term])
-> [Arg Term] -> TCMT IO [Arg Term]
forall a b. (a -> b) -> a -> b
$ [Arg Term] -> [Arg Term]
forall a. [a] -> [a]
init [Arg Term]
args [Arg Term] -> [Arg Term] -> [Arg Term]
forall a. [a] -> [a] -> [a]
++ [Arg Term
p]
      -- phi <- reduce phi
      -- forallFaceMaps (unArg phi) $ \ alpha -> do
      --   iv@(PathType s _ l a x y) <- idViewAsPath (applySubst alpha t1)
      --   let ty = pathUnview iv
      --   equalTerm (El s (unArg a)) (unArg x) (unArg y) -- precondition for cx being well-typed at ty
      --   cx <- pathAbs iv (NoAbs (stringToArgName "_") (applySubst alpha (unArg x)))
      --   equalTerm ty (applySubst alpha (unArg p)) cx   -- G, phi |- p = \ i . x
   [Arg Term]
_ -> TypeError -> TCMT IO [Arg Term]
forall (m :: * -> *) a.
(MonadTCEnv m, ReadTCState m, MonadError TCErr m) =>
TypeError -> m a
typeError (TypeError -> TCMT IO [Arg Term])
-> TypeError -> TCMT IO [Arg Term]
forall a b. (a -> b) -> a -> b
$ VerboseKey -> TypeError
GenericError (VerboseKey -> TypeError) -> VerboseKey -> TypeError
forall a b. (a -> b) -> a -> b
$ QName -> VerboseKey
forall a. Show a => a -> VerboseKey
show QName
c VerboseKey -> VerboseKey -> VerboseKey
forall a. [a] -> [a] -> [a]
++ VerboseKey
" must be fully applied"


-- The following comment contains silly ' escapes to calm CPP about ∨ (\vee).
-- May not be haddock-parseable.

-- ' @primPOr : ∀ {ℓ} (φ₁ φ₂ : I) {A : Partial (φ₁ ∨ φ₂) (Set ℓ)}
-- '         → (u : PartialP φ₁ (λ (o : IsOne φ₁) → A (IsOne1 φ₁ φ₂ o)))
-- '         → (v : PartialP φ₂ (λ (o : IsOne φ₂) → A (IsOne2 φ₁ φ₂ o)))
-- '         → PartialP (φ₁ ∨ φ₂) A@
-- '
-- ' Checks: @u = v : PartialP (φ₁ ∨ φ₂) A@ whenever @IsOne (φ₁ ∧ φ₂)@.
checkPOr :: QName -> MaybeRanges -> Args -> Type -> TCM Args
checkPOr :: QName -> MaybeRanges -> [Arg Term] -> Type -> TCMT IO [Arg Term]
checkPOr QName
c MaybeRanges
rs [Arg Term]
vs Type
_ = do
  case [Arg Term]
vs of
   Arg Term
l : Arg Term
phi1 : Arg Term
phi2 : Arg Term
a : Arg Term
u : Arg Term
v : [Arg Term]
rest -> do
      Term
phi <- IntervalView -> TCM Term
forall (m :: * -> *). HasBuiltins m => IntervalView -> m Term
intervalUnview (Arg Term -> Arg Term -> IntervalView
IMin Arg Term
phi1 Arg Term
phi2)
      VerboseKey -> VerboseLevel -> TCM Doc -> TCMT IO ()
forall (m :: * -> *).
MonadDebug m =>
VerboseKey -> VerboseLevel -> TCM Doc -> m ()
reportSDoc VerboseKey
"tc.term.por" VerboseLevel
10 (TCM Doc -> TCMT IO ()) -> TCM Doc -> TCMT IO ()
forall a b. (a -> b) -> a -> b
$ VerboseKey -> TCM Doc
forall (m :: * -> *). Monad m => VerboseKey -> m Doc
text (Term -> VerboseKey
forall a. Show a => a -> VerboseKey
show Term
phi)
      -- phi <- reduce phi
      -- alphas <- toFaceMaps phi
      -- reportSDoc "tc.term.por" 10 $ text (show alphas)
      Type
t1 <- [VerboseKey] -> NamesT TCM Type -> TCMT IO Type
forall (m :: * -> *) a. [VerboseKey] -> NamesT m a -> m a
runNamesT [] (NamesT TCM Type -> TCMT IO Type)
-> NamesT TCM Type -> TCMT IO Type
forall a b. (a -> b) -> a -> b
$ do
             [NamesT TCM Term
l,NamesT TCM Term
a] <- (Arg Term -> NamesT TCM (NamesT TCM Term))
-> [Arg Term] -> NamesT TCM [NamesT TCM Term]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Term -> NamesT TCM (NamesT TCM Term)
forall (m :: * -> *) t a.
(MonadFail m, Subst t a) =>
a -> NamesT m (NamesT m a)
open (Term -> NamesT TCM (NamesT TCM Term))
-> (Arg Term -> Term) -> Arg Term -> NamesT TCM (NamesT TCM Term)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Arg Term -> Term
forall e. Arg e -> e
unArg) [Arg Term
l,Arg Term
a]
             NamesT TCM Term
psi <- Term -> NamesT TCM (NamesT TCM Term)
forall (m :: * -> *) t a.
(MonadFail m, Subst t a) =>
a -> NamesT m (NamesT m a)
open (Term -> NamesT TCM (NamesT TCM Term))
-> NamesT TCM Term -> NamesT TCM (NamesT TCM Term)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IntervalView -> NamesT TCM Term
forall (m :: * -> *). HasBuiltins m => IntervalView -> m Term
intervalUnview (Arg Term -> Arg Term -> IntervalView
IMax Arg Term
phi1 Arg Term
phi2)
             VerboseKey
-> NamesT TCM Term
-> (NamesT TCM Term -> NamesT TCM Type)
-> NamesT TCM Type
forall (m :: * -> *).
(MonadAddContext m, HasBuiltins m, MonadDebug m) =>
VerboseKey
-> NamesT m Term
-> (NamesT m Term -> NamesT m Type)
-> NamesT m Type
pPi' VerboseKey
"o" NamesT TCM Term
psi ((NamesT TCM Term -> NamesT TCM Type) -> NamesT TCM Type)
-> (NamesT TCM Term -> NamesT TCM Type) -> NamesT TCM Type
forall a b. (a -> b) -> a -> b
$ \ NamesT TCM Term
o -> NamesT TCM Term -> NamesT TCM Term -> NamesT TCM Type
forall (m :: * -> *). Monad m => m Term -> m Term -> m Type
el' NamesT TCM Term
l (NamesT TCM Term
a NamesT TCM Term -> NamesT TCM Term -> NamesT TCM Term
forall (tcm :: * -> *).
Monad tcm =>
tcm Term -> tcm Term -> tcm Term
<..> NamesT TCM Term
o)
      Type
tv <- [VerboseKey] -> NamesT TCM Type -> TCMT IO Type
forall (m :: * -> *) a. [VerboseKey] -> NamesT m a -> m a
runNamesT [] (NamesT TCM Type -> TCMT IO Type)
-> NamesT TCM Type -> TCMT IO Type
forall a b. (a -> b) -> a -> b
$ do
             [NamesT TCM Term
l,NamesT TCM Term
a,NamesT TCM Term
phi1,NamesT TCM Term
phi2] <- (Arg Term -> NamesT TCM (NamesT TCM Term))
-> [Arg Term] -> NamesT TCM [NamesT TCM Term]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Term -> NamesT TCM (NamesT TCM Term)
forall (m :: * -> *) t a.
(MonadFail m, Subst t a) =>
a -> NamesT m (NamesT m a)
open (Term -> NamesT TCM (NamesT TCM Term))
-> (Arg Term -> Term) -> Arg Term -> NamesT TCM (NamesT TCM Term)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Arg Term -> Term
forall e. Arg e -> e
unArg) [Arg Term
l,Arg Term
a,Arg Term
phi1,Arg Term
phi2]
             VerboseKey
-> NamesT TCM Term
-> (NamesT TCM Term -> NamesT TCM Type)
-> NamesT TCM Type
forall (m :: * -> *).
(MonadAddContext m, HasBuiltins m, MonadDebug m) =>
VerboseKey
-> NamesT m Term
-> (NamesT m Term -> NamesT m Type)
-> NamesT m Type
pPi' VerboseKey
"o" NamesT TCM Term
phi2 ((NamesT TCM Term -> NamesT TCM Type) -> NamesT TCM Type)
-> (NamesT TCM Term -> NamesT TCM Type) -> NamesT TCM Type
forall a b. (a -> b) -> a -> b
$ \ NamesT TCM Term
o -> NamesT TCM Term -> NamesT TCM Term -> NamesT TCM Type
forall (m :: * -> *). Monad m => m Term -> m Term -> m Type
el' NamesT TCM Term
l (NamesT TCM Term
a NamesT TCM Term -> NamesT TCM Term -> NamesT TCM Term
forall (tcm :: * -> *).
Monad tcm =>
tcm Term -> tcm Term -> tcm Term
<..> (TCM Term -> NamesT TCM Term
forall (m :: * -> *) a. Monad m => m a -> NamesT m a
cl TCM Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primIsOne2 NamesT TCM Term -> NamesT TCM Term -> NamesT TCM Term
forall (tcm :: * -> *).
Monad tcm =>
tcm Term -> tcm Term -> tcm Term
<@> NamesT TCM Term
phi1 NamesT TCM Term -> NamesT TCM Term -> NamesT TCM Term
forall (tcm :: * -> *).
Monad tcm =>
tcm Term -> tcm Term -> tcm Term
<@> NamesT TCM Term
phi2 NamesT TCM Term -> NamesT TCM Term -> NamesT TCM Term
forall (tcm :: * -> *).
Monad tcm =>
tcm Term -> tcm Term -> tcm Term
<@> NamesT TCM Term
o))
      Arg Term
v <- Type
-> Maybe (Maybe Range)
-> Arg Term
-> TCMT IO ()
-> TCMT IO (Arg Term)
forall r.
HasRange r =>
Type -> r -> Arg Term -> TCMT IO () -> TCMT IO (Arg Term)
blockArg Type
tv (MaybeRanges
rs MaybeRanges -> VerboseLevel -> Maybe (Maybe Range)
forall a. [a] -> VerboseLevel -> Maybe a
!!! VerboseLevel
5) Arg Term
v (TCMT IO () -> TCMT IO (Arg Term))
-> TCMT IO () -> TCMT IO (Arg Term)
forall a b. (a -> b) -> a -> b
$ do
        -- ' φ₁ ∧ φ₂  ⊢ u , v : PartialP (φ₁ ∨ φ₂) \ o → a o
        Term -> Type -> Term -> Term -> TCMT IO ()
forall (m :: * -> *).
MonadConversion m =>
Term -> Type -> Term -> Term -> m ()
equalTermOnFace Term
phi Type
t1 (Arg Term -> Term
forall e. Arg e -> e
unArg Arg Term
u) (Arg Term -> Term
forall e. Arg e -> e
unArg Arg Term
v)
      [Arg Term] -> TCMT IO [Arg Term]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Arg Term] -> TCMT IO [Arg Term])
-> [Arg Term] -> TCMT IO [Arg Term]
forall a b. (a -> b) -> a -> b
$ Arg Term
l Arg Term -> [Arg Term] -> [Arg Term]
forall a. a -> [a] -> [a]
: Arg Term
phi1 Arg Term -> [Arg Term] -> [Arg Term]
forall a. a -> [a] -> [a]
: Arg Term
phi2 Arg Term -> [Arg Term] -> [Arg Term]
forall a. a -> [a] -> [a]
: Arg Term
a Arg Term -> [Arg Term] -> [Arg Term]
forall a. a -> [a] -> [a]
: Arg Term
u Arg Term -> [Arg Term] -> [Arg Term]
forall a. a -> [a] -> [a]
: Arg Term
v Arg Term -> [Arg Term] -> [Arg Term]
forall a. a -> [a] -> [a]
: [Arg Term]
rest
   [Arg Term]
_ -> TypeError -> TCMT IO [Arg Term]
forall (m :: * -> *) a.
(MonadTCEnv m, ReadTCState m, MonadError TCErr m) =>
TypeError -> m a
typeError (TypeError -> TCMT IO [Arg Term])
-> TypeError -> TCMT IO [Arg Term]
forall a b. (a -> b) -> a -> b
$ VerboseKey -> TypeError
GenericError (VerboseKey -> TypeError) -> VerboseKey -> TypeError
forall a b. (a -> b) -> a -> b
$ QName -> VerboseKey
forall a. Show a => a -> VerboseKey
show QName
c VerboseKey -> VerboseKey -> VerboseKey
forall a. [a] -> [a] -> [a]
++ VerboseKey
" must be fully applied"

-- | @prim^glue : ∀ {ℓ ℓ'} {A : Set ℓ} {φ : I}
--              → {T : Partial φ (Set ℓ')} → {e : PartialP φ (λ o → T o ≃ A)}
--              → (t : PartialP φ T) → (a : A) → primGlue A T e@
--
--   Check   @φ ⊢ a = e 1=1 (t 1=1)@  or actually the equivalent:  @(\ _ → a) = (\ o -> e o (t o)) : PartialP φ A@
check_glue :: QName -> MaybeRanges -> Args -> Type -> TCM Args
check_glue :: QName -> MaybeRanges -> [Arg Term] -> Type -> TCMT IO [Arg Term]
check_glue QName
c MaybeRanges
rs [Arg Term]
vs Type
_ = do
  case [Arg Term]
vs of
   -- WAS: [la, lb, bA, phi, bT, e, t, a] -> do
   Arg Term
la : Arg Term
lb : Arg Term
bA : Arg Term
phi : Arg Term
bT : Arg Term
e : Arg Term
t : Arg Term
a : [Arg Term]
rest -> do
      let iinfo :: ArgInfo
iinfo = Relevance -> ArgInfo -> ArgInfo
forall a. LensRelevance a => Relevance -> a -> a
setRelevance Relevance
Irrelevant ArgInfo
defaultArgInfo
      Term
v <- [VerboseKey] -> NamesT TCM Term -> TCM Term
forall (m :: * -> *) a. [VerboseKey] -> NamesT m a -> m a
runNamesT [] (NamesT TCM Term -> TCM Term) -> NamesT TCM Term -> TCM Term
forall a b. (a -> b) -> a -> b
$ do
            [NamesT TCM Term
lb, NamesT TCM Term
la, NamesT TCM Term
bA, NamesT TCM Term
phi, NamesT TCM Term
bT, NamesT TCM Term
e, NamesT TCM Term
t] <- (Arg Term -> NamesT TCM (NamesT TCM Term))
-> [Arg Term] -> NamesT TCM [NamesT TCM Term]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Term -> NamesT TCM (NamesT TCM Term)
forall (m :: * -> *) t a.
(MonadFail m, Subst t a) =>
a -> NamesT m (NamesT m a)
open (Term -> NamesT TCM (NamesT TCM Term))
-> (Arg Term -> Term) -> Arg Term -> NamesT TCM (NamesT TCM Term)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Arg Term -> Term
forall e. Arg e -> e
unArg) [Arg Term
lb, Arg Term
la, Arg Term
bA, Arg Term
phi, Arg Term
bT, Arg Term
e, Arg Term
t]
            let f :: NamesT TCM Term -> NamesT TCM Term
f NamesT TCM Term
o = TCM Term -> NamesT TCM Term
forall (m :: * -> *) a. Monad m => m a -> NamesT m a
cl TCM Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primEquivFun NamesT TCM Term -> NamesT TCM Term -> NamesT TCM Term
forall (tcm :: * -> *).
Monad tcm =>
tcm Term -> tcm Term -> tcm Term
<#> NamesT TCM Term
lb NamesT TCM Term -> NamesT TCM Term -> NamesT TCM Term
forall (tcm :: * -> *).
Monad tcm =>
tcm Term -> tcm Term -> tcm Term
<#> NamesT TCM Term
la NamesT TCM Term -> NamesT TCM Term -> NamesT TCM Term
forall (tcm :: * -> *).
Monad tcm =>
tcm Term -> tcm Term -> tcm Term
<#> (NamesT TCM Term
bT NamesT TCM Term -> NamesT TCM Term -> NamesT TCM Term
forall (tcm :: * -> *).
Monad tcm =>
tcm Term -> tcm Term -> tcm Term
<..> NamesT TCM Term
o) NamesT TCM Term -> NamesT TCM Term -> NamesT TCM Term
forall (tcm :: * -> *).
Monad tcm =>
tcm Term -> tcm Term -> tcm Term
<#> NamesT TCM Term
bA NamesT TCM Term -> NamesT TCM Term -> NamesT TCM Term
forall (tcm :: * -> *).
Monad tcm =>
tcm Term -> tcm Term -> tcm Term
<@> (NamesT TCM Term
e NamesT TCM Term -> NamesT TCM Term -> NamesT TCM Term
forall (tcm :: * -> *).
Monad tcm =>
tcm Term -> tcm Term -> tcm Term
<..> NamesT TCM Term
o)
            ArgInfo
-> VerboseKey
-> (NamesT TCM Term -> NamesT TCM Term)
-> NamesT TCM Term
forall (m :: * -> *).
MonadFail m =>
ArgInfo
-> VerboseKey -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
glam ArgInfo
iinfo VerboseKey
"o" ((NamesT TCM Term -> NamesT TCM Term) -> NamesT TCM Term)
-> (NamesT TCM Term -> NamesT TCM Term) -> NamesT TCM Term
forall a b. (a -> b) -> a -> b
$ \ NamesT TCM Term
o -> NamesT TCM Term -> NamesT TCM Term
f NamesT TCM Term
o NamesT TCM Term -> NamesT TCM Term -> NamesT TCM Term
forall (tcm :: * -> *).
Monad tcm =>
tcm Term -> tcm Term -> tcm Term
<@> (NamesT TCM Term
t NamesT TCM Term -> NamesT TCM Term -> NamesT TCM Term
forall (tcm :: * -> *).
Monad tcm =>
tcm Term -> tcm Term -> tcm Term
<..> NamesT TCM Term
o)
      Type
ty <- [VerboseKey] -> NamesT TCM Type -> TCMT IO Type
forall (m :: * -> *) a. [VerboseKey] -> NamesT m a -> m a
runNamesT [] (NamesT TCM Type -> TCMT IO Type)
-> NamesT TCM Type -> TCMT IO Type
forall a b. (a -> b) -> a -> b
$ do
            [NamesT TCM Term
lb, NamesT TCM Term
phi, NamesT TCM Term
bA] <- (Arg Term -> NamesT TCM (NamesT TCM Term))
-> [Arg Term] -> NamesT TCM [NamesT TCM Term]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Term -> NamesT TCM (NamesT TCM Term)
forall (m :: * -> *) t a.
(MonadFail m, Subst t a) =>
a -> NamesT m (NamesT m a)
open (Term -> NamesT TCM (NamesT TCM Term))
-> (Arg Term -> Term) -> Arg Term -> NamesT TCM (NamesT TCM Term)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Arg Term -> Term
forall e. Arg e -> e
unArg) [Arg Term
lb, Arg Term
phi, Arg Term
bA]
            NamesT TCM Term -> NamesT TCM Type
forall (m :: * -> *). Functor m => m Term -> m Type
elInf (NamesT TCM Term -> NamesT TCM Type)
-> NamesT TCM Term -> NamesT TCM Type
forall a b. (a -> b) -> a -> b
$ TCM Term -> NamesT TCM Term
forall (m :: * -> *) a. Monad m => m a -> NamesT m a
cl TCM Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primPartialP NamesT TCM Term -> NamesT TCM Term -> NamesT TCM Term
forall (tcm :: * -> *).
Monad tcm =>
tcm Term -> tcm Term -> tcm Term
<#> NamesT TCM Term
lb NamesT TCM Term -> NamesT TCM Term -> NamesT TCM Term
forall (tcm :: * -> *).
Monad tcm =>
tcm Term -> tcm Term -> tcm Term
<@> NamesT TCM Term
phi NamesT TCM Term -> NamesT TCM Term -> NamesT TCM Term
forall (tcm :: * -> *).
Monad tcm =>
tcm Term -> tcm Term -> tcm Term
<@> (ArgInfo
-> VerboseKey
-> (NamesT TCM Term -> NamesT TCM Term)
-> NamesT TCM Term
forall (m :: * -> *).
MonadFail m =>
ArgInfo
-> VerboseKey -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
glam ArgInfo
iinfo VerboseKey
"o" ((NamesT TCM Term -> NamesT TCM Term) -> NamesT TCM Term)
-> (NamesT TCM Term -> NamesT TCM Term) -> NamesT TCM Term
forall a b. (a -> b) -> a -> b
$ \ NamesT TCM Term
_ -> NamesT TCM Term
bA)
      let a' :: Term
a' = ArgInfo -> Abs Term -> Term
Lam ArgInfo
iinfo (VerboseKey -> Term -> Abs Term
forall a. VerboseKey -> a -> Abs a
NoAbs VerboseKey
"o" (Term -> Abs Term) -> Term -> Abs Term
forall a b. (a -> b) -> a -> b
$ Arg Term -> Term
forall e. Arg e -> e
unArg Arg Term
a)
      Type
ta <- TCM Term -> TCM Term -> TCMT IO Type
forall (m :: * -> *). Monad m => m Term -> m Term -> m Type
el' (Term -> TCM Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term -> TCM Term) -> Term -> TCM Term
forall a b. (a -> b) -> a -> b
$ Arg Term -> Term
forall e. Arg e -> e
unArg Arg Term
la) (Term -> TCM Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term -> TCM Term) -> Term -> TCM Term
forall a b. (a -> b) -> a -> b
$ Arg Term -> Term
forall e. Arg e -> e
unArg Arg Term
bA)
      Arg Term
a <- Type
-> Maybe (Maybe Range)
-> Arg Term
-> TCMT IO ()
-> TCMT IO (Arg Term)
forall r.
HasRange r =>
Type -> r -> Arg Term -> TCMT IO () -> TCMT IO (Arg Term)
blockArg Type
ta (MaybeRanges
rs MaybeRanges -> VerboseLevel -> Maybe (Maybe Range)
forall a. [a] -> VerboseLevel -> Maybe a
!!! VerboseLevel
7) Arg Term
a (TCMT IO () -> TCMT IO (Arg Term))
-> TCMT IO () -> TCMT IO (Arg Term)
forall a b. (a -> b) -> a -> b
$ Type -> Term -> Term -> TCMT IO ()
forall (m :: * -> *).
MonadConversion m =>
Type -> Term -> Term -> m ()
equalTerm Type
ty Term
a' Term
v
      [Arg Term] -> TCMT IO [Arg Term]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Arg Term] -> TCMT IO [Arg Term])
-> [Arg Term] -> TCMT IO [Arg Term]
forall a b. (a -> b) -> a -> b
$ Arg Term
la Arg Term -> [Arg Term] -> [Arg Term]
forall a. a -> [a] -> [a]
: Arg Term
lb Arg Term -> [Arg Term] -> [Arg Term]
forall a. a -> [a] -> [a]
: Arg Term
bA Arg Term -> [Arg Term] -> [Arg Term]
forall a. a -> [a] -> [a]
: Arg Term
phi Arg Term -> [Arg Term] -> [Arg Term]
forall a. a -> [a] -> [a]
: Arg Term
bT Arg Term -> [Arg Term] -> [Arg Term]
forall a. a -> [a] -> [a]
: Arg Term
e Arg Term -> [Arg Term] -> [Arg Term]
forall a. a -> [a] -> [a]
: Arg Term
t Arg Term -> [Arg Term] -> [Arg Term]
forall a. a -> [a] -> [a]
: Arg Term
a Arg Term -> [Arg Term] -> [Arg Term]
forall a. a -> [a] -> [a]
: [Arg Term]
rest
   [Arg Term]
_ -> TypeError -> TCMT IO [Arg Term]
forall (m :: * -> *) a.
(MonadTCEnv m, ReadTCState m, MonadError TCErr m) =>
TypeError -> m a
typeError (TypeError -> TCMT IO [Arg Term])
-> TypeError -> TCMT IO [Arg Term]
forall a b. (a -> b) -> a -> b
$ VerboseKey -> TypeError
GenericError (VerboseKey -> TypeError) -> VerboseKey -> TypeError
forall a b. (a -> b) -> a -> b
$ QName -> VerboseKey
forall a. Show a => a -> VerboseKey
show QName
c VerboseKey -> VerboseKey -> VerboseKey
forall a. [a] -> [a] -> [a]
++ VerboseKey
" must be fully applied"


-- | @prim^glueU : ∀ {ℓ} {φ : I}
--              → {T : I → Partial φ (Set ℓ)} → {A : Set ℓ [ φ ↦ T i0 ]}
--              → (t : PartialP φ (T i1)) → (a : outS A) → hcomp T (outS A)@
--
--   Check   @φ ⊢ a = transp (\ i -> T 1=1 (~ i)) i0 (t 1=1)@  or actually the equivalent:
--           @(\ _ → a) = (\o -> transp (\ i -> T o (~ i)) i0 (t o)) : PartialP φ (T i0)@
check_glueU :: QName -> MaybeRanges -> Args -> Type -> TCM Args
check_glueU :: QName -> MaybeRanges -> [Arg Term] -> Type -> TCMT IO [Arg Term]
check_glueU QName
c MaybeRanges
rs [Arg Term]
vs Type
_ = do
  case [Arg Term]
vs of
   -- WAS: [la, lb, bA, phi, bT, e, t, a] -> do
   Arg Term
la : Arg Term
phi : Arg Term
bT : Arg Term
bA : Arg Term
t : Arg Term
a : [Arg Term]
rest -> do
      let iinfo :: ArgInfo
iinfo = Relevance -> ArgInfo -> ArgInfo
forall a. LensRelevance a => Relevance -> a -> a
setRelevance Relevance
Irrelevant ArgInfo
defaultArgInfo
      Term
v <- [VerboseKey] -> NamesT TCM Term -> TCM Term
forall (m :: * -> *) a. [VerboseKey] -> NamesT m a -> m a
runNamesT [] (NamesT TCM Term -> TCM Term) -> NamesT TCM Term -> TCM Term
forall a b. (a -> b) -> a -> b
$ do
            [NamesT TCM Term
la, NamesT TCM Term
phi, NamesT TCM Term
bT, NamesT TCM Term
bA, NamesT TCM Term
t] <- (Arg Term -> NamesT TCM (NamesT TCM Term))
-> [Arg Term] -> NamesT TCM [NamesT TCM Term]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Term -> NamesT TCM (NamesT TCM Term)
forall (m :: * -> *) t a.
(MonadFail m, Subst t a) =>
a -> NamesT m (NamesT m a)
open (Term -> NamesT TCM (NamesT TCM Term))
-> (Arg Term -> Term) -> Arg Term -> NamesT TCM (NamesT TCM Term)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Arg Term -> Term
forall e. Arg e -> e
unArg) [Arg Term
la, Arg Term
phi, Arg Term
bT, Arg Term
bA, Arg Term
t]
            let f :: NamesT TCM Term -> NamesT TCM Term
f NamesT TCM Term
o = TCM Term -> NamesT TCM Term
forall (m :: * -> *) a. Monad m => m a -> NamesT m a
cl TCM Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primTrans NamesT TCM Term -> NamesT TCM Term -> NamesT TCM Term
forall (tcm :: * -> *).
Monad tcm =>
tcm Term -> tcm Term -> tcm Term
<#> (VerboseKey
-> (NamesT TCM Term -> NamesT TCM Term) -> NamesT TCM Term
forall (m :: * -> *).
MonadFail m =>
VerboseKey -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
lam VerboseKey
"i" ((NamesT TCM Term -> NamesT TCM Term) -> NamesT TCM Term)
-> (NamesT TCM Term -> NamesT TCM Term) -> NamesT TCM Term
forall a b. (a -> b) -> a -> b
$ NamesT TCM Term -> NamesT TCM Term -> NamesT TCM Term
forall a b. a -> b -> a
const NamesT TCM Term
la) NamesT TCM Term -> NamesT TCM Term -> NamesT TCM Term
forall (tcm :: * -> *).
Monad tcm =>
tcm Term -> tcm Term -> tcm Term
<@> (VerboseKey
-> (NamesT TCM Term -> NamesT TCM Term) -> NamesT TCM Term
forall (m :: * -> *).
MonadFail m =>
VerboseKey -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
lam VerboseKey
"i" ((NamesT TCM Term -> NamesT TCM Term) -> NamesT TCM Term)
-> (NamesT TCM Term -> NamesT TCM Term) -> NamesT TCM Term
forall a b. (a -> b) -> a -> b
$ \ NamesT TCM Term
i -> NamesT TCM Term
bT NamesT TCM Term -> NamesT TCM Term -> NamesT TCM Term
forall (tcm :: * -> *).
Monad tcm =>
tcm Term -> tcm Term -> tcm Term
<@> (TCM Term -> NamesT TCM Term
forall (m :: * -> *) a. Monad m => m a -> NamesT m a
cl TCM Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primINeg NamesT TCM Term -> NamesT TCM Term -> NamesT TCM Term
forall (tcm :: * -> *).
Monad tcm =>
tcm Term -> tcm Term -> tcm Term
<@> NamesT TCM Term
i) NamesT TCM Term -> NamesT TCM Term -> NamesT TCM Term
forall (tcm :: * -> *).
Monad tcm =>
tcm Term -> tcm Term -> tcm Term
<..> NamesT TCM Term
o) NamesT TCM Term -> NamesT TCM Term -> NamesT TCM Term
forall (tcm :: * -> *).
Monad tcm =>
tcm Term -> tcm Term -> tcm Term
<@> TCM Term -> NamesT TCM Term
forall (m :: * -> *) a. Monad m => m a -> NamesT m a
cl TCM Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primIZero
            ArgInfo
-> VerboseKey
-> (NamesT TCM Term -> NamesT TCM Term)
-> NamesT TCM Term
forall (m :: * -> *).
MonadFail m =>
ArgInfo
-> VerboseKey -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
glam ArgInfo
iinfo VerboseKey
"o" ((NamesT TCM Term -> NamesT TCM Term) -> NamesT TCM Term)
-> (NamesT TCM Term -> NamesT TCM Term) -> NamesT TCM Term
forall a b. (a -> b) -> a -> b
$ \ NamesT TCM Term
o -> NamesT TCM Term -> NamesT TCM Term
f NamesT TCM Term
o NamesT TCM Term -> NamesT TCM Term -> NamesT TCM Term
forall (tcm :: * -> *).
Monad tcm =>
tcm Term -> tcm Term -> tcm Term
<@> (NamesT TCM Term
t NamesT TCM Term -> NamesT TCM Term -> NamesT TCM Term
forall (tcm :: * -> *).
Monad tcm =>
tcm Term -> tcm Term -> tcm Term
<..> NamesT TCM Term
o)
      Type
ty <- [VerboseKey] -> NamesT TCM Type -> TCMT IO Type
forall (m :: * -> *) a. [VerboseKey] -> NamesT m a -> m a
runNamesT [] (NamesT TCM Type -> TCMT IO Type)
-> NamesT TCM Type -> TCMT IO Type
forall a b. (a -> b) -> a -> b
$ do
            [NamesT TCM Term
la, NamesT TCM Term
phi, NamesT TCM Term
bT] <- (Arg Term -> NamesT TCM (NamesT TCM Term))
-> [Arg Term] -> NamesT TCM [NamesT TCM Term]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Term -> NamesT TCM (NamesT TCM Term)
forall (m :: * -> *) t a.
(MonadFail m, Subst t a) =>
a -> NamesT m (NamesT m a)
open (Term -> NamesT TCM (NamesT TCM Term))
-> (Arg Term -> Term) -> Arg Term -> NamesT TCM (NamesT TCM Term)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Arg Term -> Term
forall e. Arg e -> e
unArg) [Arg Term
la, Arg Term
phi, Arg Term
bT]
            VerboseKey
-> NamesT TCM Term
-> (NamesT TCM Term -> NamesT TCM Type)
-> NamesT TCM Type
forall (m :: * -> *).
(MonadAddContext m, HasBuiltins m, MonadDebug m) =>
VerboseKey
-> NamesT m Term
-> (NamesT m Term -> NamesT m Type)
-> NamesT m Type
pPi' VerboseKey
"o" NamesT TCM Term
phi ((NamesT TCM Term -> NamesT TCM Type) -> NamesT TCM Type)
-> (NamesT TCM Term -> NamesT TCM Type) -> NamesT TCM Type
forall a b. (a -> b) -> a -> b
$ \ NamesT TCM Term
o -> NamesT TCM Term -> NamesT TCM Term -> NamesT TCM Type
forall (m :: * -> *). Monad m => m Term -> m Term -> m Type
el' NamesT TCM Term
la (NamesT TCM Term
bT NamesT TCM Term -> NamesT TCM Term -> NamesT TCM Term
forall (tcm :: * -> *).
Monad tcm =>
tcm Term -> tcm Term -> tcm Term
<@> TCM Term -> NamesT TCM Term
forall (m :: * -> *) a. Monad m => m a -> NamesT m a
cl TCM Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primIZero NamesT TCM Term -> NamesT TCM Term -> NamesT TCM Term
forall (tcm :: * -> *).
Monad tcm =>
tcm Term -> tcm Term -> tcm Term
<..> NamesT TCM Term
o)
      let a' :: Term
a' = ArgInfo -> Abs Term -> Term
Lam ArgInfo
iinfo (VerboseKey -> Term -> Abs Term
forall a. VerboseKey -> a -> Abs a
NoAbs VerboseKey
"o" (Term -> Abs Term) -> Term -> Abs Term
forall a b. (a -> b) -> a -> b
$ Arg Term -> Term
forall e. Arg e -> e
unArg Arg Term
a)
      Type
ta <- [VerboseKey] -> NamesT TCM Type -> TCMT IO Type
forall (m :: * -> *) a. [VerboseKey] -> NamesT m a -> m a
runNamesT [] (NamesT TCM Type -> TCMT IO Type)
-> NamesT TCM Type -> TCMT IO Type
forall a b. (a -> b) -> a -> b
$ do
            [NamesT TCM Term
la, NamesT TCM Term
phi, NamesT TCM Term
bT, NamesT TCM Term
bA] <- (Arg Term -> NamesT TCM (NamesT TCM Term))
-> [Arg Term] -> NamesT TCM [NamesT TCM Term]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Term -> NamesT TCM (NamesT TCM Term)
forall (m :: * -> *) t a.
(MonadFail m, Subst t a) =>
a -> NamesT m (NamesT m a)
open (Term -> NamesT TCM (NamesT TCM Term))
-> (Arg Term -> Term) -> Arg Term -> NamesT TCM (NamesT TCM Term)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Arg Term -> Term
forall e. Arg e -> e
unArg) [Arg Term
la, Arg Term
phi, Arg Term
bT, Arg Term
bA]
            NamesT TCM Term -> NamesT TCM Term -> NamesT TCM Type
forall (m :: * -> *). Monad m => m Term -> m Term -> m Type
el' NamesT TCM Term
la (TCM Term -> NamesT TCM Term
forall (m :: * -> *) a. Monad m => m a -> NamesT m a
cl TCM Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primSubOut NamesT TCM Term -> NamesT TCM Term -> NamesT TCM Term
forall (tcm :: * -> *).
Monad tcm =>
tcm Term -> tcm Term -> tcm Term
<#> (TCM Term -> NamesT TCM Term
forall (m :: * -> *) a. Monad m => m a -> NamesT m a
cl TCM Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primLevelSuc NamesT TCM Term -> NamesT TCM Term -> NamesT TCM Term
forall (tcm :: * -> *).
Monad tcm =>
tcm Term -> tcm Term -> tcm Term
<@> NamesT TCM Term
la) NamesT TCM Term -> NamesT TCM Term -> NamesT TCM Term
forall (tcm :: * -> *).
Monad tcm =>
tcm Term -> tcm Term -> tcm Term
<#> (Sort' Term -> Term
Sort (Sort' Term -> Term) -> (Term -> Sort' Term) -> Term -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term -> Sort' Term
tmSort (Term -> Term) -> NamesT TCM Term -> NamesT TCM Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamesT TCM Term
la) NamesT TCM Term -> NamesT TCM Term -> NamesT TCM Term
forall (tcm :: * -> *).
Monad tcm =>
tcm Term -> tcm Term -> tcm Term
<#> NamesT TCM Term
phi NamesT TCM Term -> NamesT TCM Term -> NamesT TCM Term
forall (tcm :: * -> *).
Monad tcm =>
tcm Term -> tcm Term -> tcm Term
<#> (NamesT TCM Term
bT NamesT TCM Term -> NamesT TCM Term -> NamesT TCM Term
forall (tcm :: * -> *).
Monad tcm =>
tcm Term -> tcm Term -> tcm Term
<@> TCM Term -> NamesT TCM Term
forall (m :: * -> *) a. Monad m => m a -> NamesT m a
cl TCM Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primIZero) NamesT TCM Term -> NamesT TCM Term -> NamesT TCM Term
forall (tcm :: * -> *).
Monad tcm =>
tcm Term -> tcm Term -> tcm Term
<@> NamesT TCM Term
bA)
      Arg Term
a <- Type
-> Maybe (Maybe Range)
-> Arg Term
-> TCMT IO ()
-> TCMT IO (Arg Term)
forall r.
HasRange r =>
Type -> r -> Arg Term -> TCMT IO () -> TCMT IO (Arg Term)
blockArg Type
ta (MaybeRanges
rs MaybeRanges -> VerboseLevel -> Maybe (Maybe Range)
forall a. [a] -> VerboseLevel -> Maybe a
!!! VerboseLevel
5) Arg Term
a (TCMT IO () -> TCMT IO (Arg Term))
-> TCMT IO () -> TCMT IO (Arg Term)
forall a b. (a -> b) -> a -> b
$ Type -> Term -> Term -> TCMT IO ()
forall (m :: * -> *).
MonadConversion m =>
Type -> Term -> Term -> m ()
equalTerm Type
ty Term
a' Term
v
      [Arg Term] -> TCMT IO [Arg Term]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Arg Term] -> TCMT IO [Arg Term])
-> [Arg Term] -> TCMT IO [Arg Term]
forall a b. (a -> b) -> a -> b
$ Arg Term
la Arg Term -> [Arg Term] -> [Arg Term]
forall a. a -> [a] -> [a]
: Arg Term
phi Arg Term -> [Arg Term] -> [Arg Term]
forall a. a -> [a] -> [a]
: Arg Term
bT Arg Term -> [Arg Term] -> [Arg Term]
forall a. a -> [a] -> [a]
: Arg Term
bA Arg Term -> [Arg Term] -> [Arg Term]
forall a. a -> [a] -> [a]
: Arg Term
t Arg Term -> [Arg Term] -> [Arg Term]
forall a. a -> [a] -> [a]
: Arg Term
a Arg Term -> [Arg Term] -> [Arg Term]
forall a. a -> [a] -> [a]
: [Arg Term]
rest
   [Arg Term]
_ -> TypeError -> TCMT IO [Arg Term]
forall (m :: * -> *) a.
(MonadTCEnv m, ReadTCState m, MonadError TCErr m) =>
TypeError -> m a
typeError (TypeError -> TCMT IO [Arg Term])
-> TypeError -> TCMT IO [Arg Term]
forall a b. (a -> b) -> a -> b
$ VerboseKey -> TypeError
GenericError (VerboseKey -> TypeError) -> VerboseKey -> TypeError
forall a b. (a -> b) -> a -> b
$ QName -> VerboseKey
forall a. Show a => a -> VerboseKey
show QName
c VerboseKey -> VerboseKey -> VerboseKey
forall a. [a] -> [a] -> [a]
++ VerboseKey
" must be fully applied"