    {-# LANGUAGE NondecreasingIndentation #-}

    module Agda.TypeChecking.Conversion where

    import Control.Arrow (second)
    import Control.Monad
    import Control.Monad.Except
    -- Control.Monad.Fail import is redundant since GHC 8.8.1
    import Control.Monad.Fail (MonadFail)

    import Data.Function
    import Data.Semigroup ((<>))
    import qualified Data.List as List
    import qualified Data.Map as Map
    import qualified Data.Set as Set
    import qualified Data.IntSet as IntSet

    import Agda.Syntax.Common
    import Agda.Syntax.Internal
    import Agda.Syntax.Internal.MetaVars
    import Agda.Syntax.Translation.InternalToAbstract (reify)

    import Agda.TypeChecking.Monad
    import Agda.TypeChecking.MetaVars
    import Agda.TypeChecking.MetaVars.Occurs (killArgs,PruneResult(..),rigidVarsNotContainedIn)
    import Agda.TypeChecking.Names
    import Agda.TypeChecking.Reduce
    import Agda.TypeChecking.Substitute
    import qualified Agda.TypeChecking.SyntacticEquality as SynEq
    import Agda.TypeChecking.Telescope
    import Agda.TypeChecking.Constraints
    import Agda.TypeChecking.Conversion.Pure (pureCompareAs)
    import {-# SOURCE #-} Agda.TypeChecking.CheckInternal (infer)
    import Agda.TypeChecking.Forcing (isForced, nextIsForced)
    import Agda.TypeChecking.Free
    import Agda.TypeChecking.Datatypes (getConType, getFullyAppliedConType)
    import Agda.TypeChecking.Records
    import Agda.TypeChecking.Pretty
    import Agda.TypeChecking.Injectivity
    import Agda.TypeChecking.Polarity
    import Agda.TypeChecking.SizedTypes
    import Agda.TypeChecking.Level
    import Agda.TypeChecking.Implicit (implicitArgs)
    import Agda.TypeChecking.Irrelevance
    import Agda.TypeChecking.Primitive
    import Agda.TypeChecking.Warnings (MonadWarning)
    import Agda.Interaction.Options

    import Agda.Utils.Functor
    import Agda.Utils.List1 (List1, pattern (:|))
    import qualified Agda.Utils.List1 as List1
    import Agda.Utils.Monad
    import Agda.Utils.Maybe
    import Agda.Utils.Permutation
    import Agda.Utils.Pretty (prettyShow)
    import Agda.Utils.Size
    import Agda.Utils.Tuple
    import Agda.Utils.WithDefault

    import Agda.Utils.Impossible

    type MonadConversion m =
      ( PureTCM m
      , MonadConstraint m
      , MonadMetaSolver m
      , MonadError TCErr m
      , MonadWarning m
      , MonadStatistics m
      , MonadFresh ProblemId m
      , MonadFresh Int m
      , MonadFail m
      )

    -- | Try whether a computation runs without errors or new constraints
    --   (may create new metas, though).
    --   Restores state upon failure.
    tryConversion
      :: (MonadConstraint m, MonadWarning m, MonadError TCErr m, MonadFresh ProblemId m)
      => m () -> m Bool
    tryConversion :: forall (m :: * -> *).
    (MonadConstraint m, MonadWarning m, MonadError TCErr m,
     MonadFresh ProblemId m) =>
    m () -> m Bool
    tryConversion = Maybe () -> Bool
    forall a. Maybe a -> Bool
    isJust (Maybe () -> Bool) -> (m () -> m (Maybe ())) -> m () -> m Bool
    forall (m :: * -> *) b c a.
    Functor m =>
    (b -> c) -> (a -> m b) -> a -> m c
    <.> m () -> m (Maybe ())
    forall (m :: * -> *) a.
    (MonadConstraint m, MonadWarning m, MonadError TCErr m,
     MonadFresh ProblemId m) =>
    m a -> m (Maybe a)
    tryConversion'

    -- | Try whether a computation runs without errors or new constraints
    --   (may create new metas, though).
    --   Return 'Just' the result upon success.
    --   Return 'Nothing' and restore state upon failure.
    tryConversion'
      :: (MonadConstraint m, MonadWarning m, MonadError TCErr m, MonadFresh ProblemId m)
      => m a -> m (Maybe a)
    tryConversion' :: forall (m :: * -> *) a.
    (MonadConstraint m, MonadWarning m, MonadError TCErr m,
     MonadFresh ProblemId m) =>
    m a -> m (Maybe a)
    tryConversion' m a
    m = m a -> m (Maybe a)
    forall e (m :: * -> *) a.
    (MonadError e m, Functor m) =>
    m a -> m (Maybe a)
    tryMaybe (m a -> m (Maybe a)) -> m a -> m (Maybe a)
    forall a b. (a -> b) -> a -> b
    $ m a -> m a
    forall (m :: * -> *) a.
    (MonadConstraint m, MonadWarning m, MonadError TCErr m,
     MonadFresh ProblemId m) =>
    m a -> m a
    noConstraints m a
    m

    -- | Check if to lists of arguments are the same (and all variables).
    --   Precondition: the lists have the same length.
    sameVars :: Elims -> Elims -> Bool
    sameVars :: Elims -> Elims -> Bool
    sameVars Elims
    xs Elims
    ys = [Bool] -> Bool
    forall (t :: * -> *). Foldable t => t Bool -> Bool
    and ([Bool] -> Bool) -> [Bool] -> Bool
    forall a b. (a -> b) -> a -> b
    $ (Elim' Term -> Elim' Term -> Bool) -> Elims -> Elims -> [Bool]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith Elim' Term -> Elim' Term -> Bool
    same Elims
    xs Elims
    ys
        where
            same :: Elim' Term -> Elim' Term -> Bool
    same (Apply (Arg ArgInfo
    _ (Var Int
    n []))) (Apply (Arg ArgInfo
    _ (Var Int
    m []))) = Int
    n Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    m
            same Elim' Term
    _ Elim' Term
    _ = Bool
    False

    -- | @intersectVars us vs@ checks whether all relevant elements in @us@ and @vs@
    --   are variables, and if yes, returns a prune list which says @True@ for
    --   arguments which are different and can be pruned.
    intersectVars :: Elims -> Elims -> Maybe [Bool]
    intersectVars :: Elims -> Elims -> Maybe [Bool]
    intersectVars = (Elim' Term -> Elim' Term -> Maybe Bool)
    -> Elims -> Elims -> Maybe [Bool]
    forall (m :: * -> *) a b c.
    Applicative m =>
    (a -> b -> m c) -> [a] -> [b] -> m [c]
    zipWithM Elim' Term -> Elim' Term -> Maybe Bool
    areVars where
        -- ignore irrelevant args
        areVars :: Elim' Term -> Elim' Term -> Maybe Bool
    areVars (Apply Arg Term
    u) Elim' Term
    v | Arg Term -> Bool
    forall a. LensRelevance a => a -> Bool
    isIrrelevant Arg Term
    u = Bool -> Maybe Bool
    forall a. a -> Maybe a
    Just Bool
    False -- do not prune
        areVars (Apply (Arg ArgInfo
    _ (Var Int
    n []))) (Apply (Arg ArgInfo
    _ (Var Int
    m []))) = Bool -> Maybe Bool
    forall a. a -> Maybe a
    Just (Bool -> Maybe Bool) -> Bool -> Maybe Bool
    forall a b. (a -> b) -> a -> b
    $ Int
    n Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Int
    m -- prune different vars
        areVars Elim' Term
    _ Elim' Term
    _                                   = Maybe Bool
    forall a. Maybe a
    Nothing

    -- | Run the given computation but turn any errors into blocked computations with the given blocker
    blockOnError :: MonadError TCErr m => Blocker -> m a -> m a
    blockOnError :: forall (m :: * -> *) a. MonadError TCErr m => Blocker -> m a -> m a
    blockOnError Blocker
    blocker m a
    f
      | Blocker
    blocker Blocker -> Blocker -> Bool
    forall a. Eq a => a -> a -> Bool
    == Blocker
    neverUnblock = m a
    f
      | Bool
    otherwise               = m a
    f m a -> (TCErr -> m a) -> m a
    forall e (m :: * -> *) a.
    MonadError e m =>
    m a -> (e -> m a) -> m a
    `catchError` \case
        TypeError{}         -> TCErr -> m a
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError (TCErr -> m a) -> TCErr -> m a
    forall a b. (a -> b) -> a -> b
    $ Blocker -> TCErr
    PatternErr Blocker
    blocker
        PatternErr Blocker
    blocker' -> TCErr -> m a
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError (TCErr -> m a) -> TCErr -> m a
    forall a b. (a -> b) -> a -> b
    $ Blocker -> TCErr
    PatternErr (Blocker -> TCErr) -> Blocker -> TCErr
    forall a b. (a -> b) -> a -> b
    $ Blocker -> Blocker -> Blocker
    unblockOnEither Blocker
    blocker Blocker
    blocker'
        err :: TCErr
    err@Exception{}     -> TCErr -> m a
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError TCErr
    err
        err :: TCErr
    err@IOException{}   -> TCErr -> m a
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError TCErr
    err

    equalTerm :: MonadConversion m => Type -> Term -> Term -> m ()
    equalTerm :: forall (m :: * -> *).
    MonadConversion m =>
    Type -> Term -> Term -> m ()
    equalTerm = Comparison -> Type -> Term -> Term -> m ()
    forall (m :: * -> *).
    MonadConversion m =>
    Comparison -> Type -> Term -> Term -> m ()
    compareTerm Comparison
    CmpEq

    equalAtom :: MonadConversion m => CompareAs -> Term -> Term -> m ()
    equalAtom :: forall (m :: * -> *).
    MonadConversion m =>
    CompareAs -> Term -> Term -> m ()
    equalAtom = Comparison -> CompareAs -> Term -> Term -> m ()
    forall (m :: * -> *).
    MonadConversion m =>
    Comparison -> CompareAs -> Term -> Term -> m ()
    compareAtom Comparison
    CmpEq

    equalType :: MonadConversion m => Type -> Type -> m ()
    equalType :: forall (m :: * -> *). MonadConversion m => Type -> Type -> m ()
    equalType = Comparison -> Type -> Type -> m ()
    forall (m :: * -> *).
    MonadConversion m =>
    Comparison -> Type -> Type -> m ()
    compareType Comparison
    CmpEq

    {- Comparing in irrelevant context always succeeds.

       However, we might want to dig for solutions of irrelevant metas.

       To this end, we can just ignore errors during conversion checking.
     -}

    -- convError ::  MonadTCM tcm => TypeError -> tcm a
    -- | Ignore errors in irrelevant context.
    convError :: TypeError -> TCM ()
    convError :: TypeError -> TCM ()
    convError TypeError
    err = TCMT IO Bool -> TCM () -> TCM () -> TCM ()
    forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
    ifM (Relevance -> Relevance -> Bool
    forall a. Eq a => a -> a -> Bool
    (==) Relevance
    Irrelevant (Relevance -> Bool) -> TCMT IO Relevance -> TCMT IO Bool
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (TCEnv -> Relevance) -> TCMT IO Relevance
    forall (m :: * -> *) a. MonadTCEnv m => (TCEnv -> a) -> m a
    asksTC TCEnv -> Relevance
    forall a. LensRelevance a => a -> Relevance
    getRelevance) (() -> TCM ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()) (TCM () -> TCM ()) -> TCM () -> TCM ()
    forall a b. (a -> b) -> a -> b
    $ TypeError -> TCM ()
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCError m) =>
    TypeError -> m a
    typeError TypeError
    err

    -- | Type directed equality on values.
    --
    compareTerm :: forall m. MonadConversion m => Comparison -> Type -> Term -> Term -> m ()
    compareTerm :: forall (m :: * -> *).
    MonadConversion m =>
    Comparison -> Type -> Term -> Term -> m ()
    compareTerm Comparison
    cmp Type
    a Term
    u Term
    v = Comparison -> CompareAs -> Term -> Term -> m ()
    forall (m :: * -> *).
    MonadConversion m =>
    Comparison -> CompareAs -> Term -> Term -> m ()
    compareAs Comparison
    cmp (Type -> CompareAs
    AsTermsOf Type
    a) Term
    u Term
    v

    -- | Type directed equality on terms or types.
    compareAs :: forall m. MonadConversion m => Comparison -> CompareAs -> Term -> Term -> m ()
      -- If one term is a meta, try to instantiate right away. This avoids unnecessary unfolding.
      -- Andreas, 2012-02-14: This is UNSOUND for subtyping!
    compareAs :: forall (m :: * -> *).
    MonadConversion m =>
    Comparison -> CompareAs -> Term -> Term -> m ()
    compareAs Comparison
    cmp CompareAs
    a Term
    u Term
    v = do
      VerboseKey -> Int -> TCMT IO Doc -> m ()
    forall (m :: * -> *).
    MonadDebug m =>
    VerboseKey -> Int -> TCMT IO Doc -> m ()
    reportSDoc VerboseKey
    "tc.conv.term" Int
    20 (TCMT IO Doc -> m ()) -> TCMT IO Doc -> m ()
    forall a b. (a -> b) -> a -> b
    $ [TCMT IO Doc] -> TCMT IO Doc
    forall (m :: * -> *) (t :: * -> *).
    (Applicative m, Foldable t) =>
    t (m Doc) -> m Doc
    sep ([TCMT IO Doc] -> TCMT IO Doc) -> [TCMT IO Doc] -> TCMT IO Doc
    forall a b. (a -> b) -> a -> b
    $
        [ TCMT IO Doc
    "compareTerm"
        , Int -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Functor m => Int -> m Doc -> m Doc
    nest Int
    2 (TCMT IO Doc -> TCMT IO Doc) -> TCMT IO Doc -> TCMT IO Doc
    forall a b. (a -> b) -> a -> b
    $ Term -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM Term
    u TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> Comparison -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM Comparison
    cmp TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> Term -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM Term
    v
        , Int -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Functor m => Int -> m Doc -> m Doc
    nest Int
    2 (TCMT IO Doc -> TCMT IO Doc) -> TCMT IO Doc -> TCMT IO Doc
    forall a b. (a -> b) -> a -> b
    $ CompareAs -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM CompareAs
    a
        ]
      -- Check syntactic equality. This actually saves us quite a bit of work.
      ((Term
    u, Term
    v), Bool
    equal) <- Term -> Term -> m ((Term, Term), Bool)
    forall a (m :: * -> *).
    (Instantiate a, SynEq a, MonadReduce m) =>
    a -> a -> m ((a, a), Bool)
    SynEq.checkSyntacticEquality Term
    u Term
    v
      -- OLD CODE, traverses the *full* terms u v at each step, even if they
      -- are different somewhere.  Leads to infeasibility in issue 854.
      -- (u, v) <- instantiateFull (u, v)
      -- let equal = u == v
      if Bool
    equal then VerboseKey -> Int -> m () -> m ()
    forall (m :: * -> *).
    MonadDebug m =>
    VerboseKey -> Int -> m () -> m ()
    verboseS VerboseKey
    "profile.sharing" Int
    20 (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $ VerboseKey -> m ()
    forall (m :: * -> *). MonadStatistics m => VerboseKey -> m ()
    tick VerboseKey
    "equal terms" else do
          VerboseKey -> Int -> m () -> m ()
    forall (m :: * -> *).
    MonadDebug m =>
    VerboseKey -> Int -> m () -> m ()
    verboseS VerboseKey
    "profile.sharing" Int
    20 (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $ VerboseKey -> m ()
    forall (m :: * -> *). MonadStatistics m => VerboseKey -> m ()
    tick VerboseKey
    "unequal terms"
          VerboseKey -> Int -> TCMT IO Doc -> m ()
    forall (m :: * -> *).
    MonadDebug m =>
    VerboseKey -> Int -> TCMT IO Doc -> m ()
    reportSDoc VerboseKey
    "tc.conv.term" Int
    15 (TCMT IO Doc -> m ()) -> TCMT IO Doc -> m ()
    forall a b. (a -> b) -> a -> b
    $ [TCMT IO Doc] -> TCMT IO Doc
    forall (m :: * -> *) (t :: * -> *).
    (Applicative m, Foldable t) =>
    t (m Doc) -> m Doc
    sep ([TCMT IO Doc] -> TCMT IO Doc) -> [TCMT IO Doc] -> TCMT IO Doc
    forall a b. (a -> b) -> a -> b
    $
            [ TCMT IO Doc
    "compareTerm (not syntactically equal)"
            , Int -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Functor m => Int -> m Doc -> m Doc
    nest Int
    2 (TCMT IO Doc -> TCMT IO Doc) -> TCMT IO Doc -> TCMT IO Doc
    forall a b. (a -> b) -> a -> b
    $ Term -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM Term
    u TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> Comparison -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM Comparison
    cmp TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> Term -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM Term
    v
            , Int -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Functor m => Int -> m Doc -> m Doc
    nest Int
    2 (TCMT IO Doc -> TCMT IO Doc) -> TCMT IO Doc -> TCMT IO Doc
    forall a b. (a -> b) -> a -> b
    $ CompareAs -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM CompareAs
    a
            ]
          -- If we are at type Size, we cannot short-cut comparison
          -- against metas by assignment.
          -- Andreas, 2014-04-12: this looks incomplete.
          -- It seems to assume we are never comparing
          -- at function types into Size.
          let fallback :: m ()
    fallback = Comparison -> CompareAs -> Term -> Term -> m ()
    forall (m :: * -> *).
    MonadConversion m =>
    Comparison -> CompareAs -> Term -> Term -> m ()
    compareAs' Comparison
    cmp CompareAs
    a Term
    u Term
    v
              unlessSubtyping :: m () -> m ()
              unlessSubtyping :: m () -> m ()
    unlessSubtyping m ()
    cont =
                  if Comparison
    cmp Comparison -> Comparison -> Bool
    forall a. Eq a => a -> a -> Bool
    == Comparison
    CmpEq then m ()
    cont else do
                    -- Andreas, 2014-04-12 do not short cut if type is blocked.
                    CompareAs
    -> (Blocker -> CompareAs -> m ())
    -> (NotBlocked -> CompareAs -> m ())
    -> m ()
    forall t (m :: * -> *) a.
    (Reduce t, IsMeta t, MonadReduce m) =>
    t -> (Blocker -> t -> m a) -> (NotBlocked -> t -> m a) -> m a
    ifBlocked CompareAs
    a (\ Blocker
    _ CompareAs
    _ -> m ()
    fallback) {-else-} ((NotBlocked -> CompareAs -> m ()) -> m ())
    -> (NotBlocked -> CompareAs -> m ()) -> m ()
    forall a b. (a -> b) -> a -> b
    $ \ NotBlocked
    _ CompareAs
    a -> do
                      -- do not short circuit size comparison!
                      m (Maybe BoundedSize) -> m () -> (BoundedSize -> m ()) -> m ()
    forall (m :: * -> *) a b.
    Monad m =>
    m (Maybe a) -> m b -> (a -> m b) -> m b
    caseMaybeM (CompareAs -> m (Maybe BoundedSize)
    forall a (m :: * -> *).
    (IsSizeType a, HasOptions m, HasBuiltins m) =>
    a -> m (Maybe BoundedSize)
    isSizeType CompareAs
    a) m ()
    cont (\ BoundedSize
    _ -> m ()
    fallback)

              dir :: CompareDirection
    dir = Comparison -> CompareDirection
    fromCmp Comparison
    cmp
              rid :: CompareDirection
    rid = CompareDirection -> CompareDirection
    flipCmp CompareDirection
    dir     -- The reverse direction.  Bad name, I know.
          case (Term
    u, Term
    v) of
            (MetaV MetaId
    x Elims
    us, MetaV MetaId
    y Elims
    vs)
              | MetaId
    x MetaId -> MetaId -> Bool
    forall a. Eq a => a -> a -> Bool
    /= MetaId
    y    -> m () -> m ()
    unlessSubtyping (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $ m ()
    solve1 m () -> m () -> m ()
    `orelse` m ()
    solve2 m () -> m () -> m ()
    `orelse` m ()
    fallback
              | Bool
    otherwise -> m ()
    fallback
              where
                (m ()
    solve1, m ()
    solve2) | MetaId
    x MetaId -> MetaId -> Bool
    forall a. Ord a => a -> a -> Bool
    > MetaId
    y     = (CompareDirection -> MetaId -> Elims -> Term -> m ()
    assign CompareDirection
    dir MetaId
    x Elims
    us Term
    v, CompareDirection -> MetaId -> Elims -> Term -> m ()
    assign CompareDirection
    rid MetaId
    y Elims
    vs Term
    u)
                                 | Bool
    otherwise = (CompareDirection -> MetaId -> Elims -> Term -> m ()
    assign CompareDirection
    rid MetaId
    y Elims
    vs Term
    u, CompareDirection -> MetaId -> Elims -> Term -> m ()
    assign CompareDirection
    dir MetaId
    x Elims
    us Term
    v)
            (MetaV MetaId
    x Elims
    us, Term
    _) -> m () -> m ()
    unlessSubtyping (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $ CompareDirection -> MetaId -> Elims -> Term -> m ()
    assign CompareDirection
    dir MetaId
    x Elims
    us Term
    v m () -> m () -> m ()
    `orelse` m ()
    fallback
            (Term
    _, MetaV MetaId
    y Elims
    vs) -> m () -> m ()
    unlessSubtyping (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $ CompareDirection -> MetaId -> Elims -> Term -> m ()
    assign CompareDirection
    rid MetaId
    y Elims
    vs Term
    u m () -> m () -> m ()
    `orelse` m ()
    fallback
            (Def QName
    f Elims
    es, Def QName
    f' Elims
    es') | QName
    f QName -> QName -> Bool
    forall a. Eq a => a -> a -> Bool
    == QName
    f' ->
              m Bool -> m () -> m () -> m ()
    forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
    ifNotM (PragmaOptions -> Bool
    optFirstOrder (PragmaOptions -> Bool) -> m PragmaOptions -> m Bool
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> m PragmaOptions
    forall (m :: * -> *). HasOptions m => m PragmaOptions
    pragmaOptions) m ()
    fallback (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $ {- else -} m () -> m ()
    unlessSubtyping (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $ do
              Definition
    def <- QName -> m Definition
    forall (m :: * -> *). HasConstInfo m => QName -> m Definition
    getConstInfo QName
    f
              -- We do not shortcut projection-likes,
              -- Andreas, 2022-03-07, issue #5809:
              -- but irrelevant projections since they are applied to their parameters.
              if Maybe Projection -> Bool
    forall a. Maybe a -> Bool
    isJust (Maybe Projection -> Bool) -> Maybe Projection -> Bool
    forall a b. (a -> b) -> a -> b
    $ Definition -> Maybe Projection
    isRelevantProjection_ Definition
    def then m ()
    fallback else do
              [Polarity]
    pol <- Comparison -> QName -> m [Polarity]
    forall (m :: * -> *).
    HasConstInfo m =>
    Comparison -> QName -> m [Polarity]
    getPolarity' Comparison
    cmp QName
    f
              [Polarity] -> [IsForced] -> Type -> Term -> Elims -> Elims -> m ()
    forall (m :: * -> *).
    MonadConversion m =>
    [Polarity] -> [IsForced] -> Type -> Term -> Elims -> Elims -> m ()
    compareElims [Polarity]
    pol [] (Definition -> Type
    defType Definition
    def) (QName -> Elims -> Term
    Def QName
    f []) Elims
    es Elims
    es' m () -> m () -> m ()
    `orelse` m ()
    fallback
            (Term, Term)
    _               -> m ()
    fallback
      where
        assign :: CompareDirection -> MetaId -> Elims -> Term -> m ()
        assign :: CompareDirection -> MetaId -> Elims -> Term -> m ()
    assign CompareDirection
    dir MetaId
    x Elims
    es Term
    v = do
          -- Andreas, 2013-10-19 can only solve if no projections
          VerboseKey -> Int -> TCMT IO Doc -> m ()
    forall (m :: * -> *).
    MonadDebug m =>
    VerboseKey -> Int -> TCMT IO Doc -> m ()
    reportSDoc VerboseKey
    "tc.conv.term.shortcut" Int
    20 (TCMT IO Doc -> m ()) -> TCMT IO Doc -> m ()
    forall a b. (a -> b) -> a -> b
    $ [TCMT IO Doc] -> TCMT IO Doc
    forall (m :: * -> *) (t :: * -> *).
    (Applicative m, Foldable t) =>
    t (m Doc) -> m Doc
    sep
            [ TCMT IO Doc
    "attempting shortcut"
            , Int -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Functor m => Int -> m Doc -> m Doc
    nest Int
    2 (TCMT IO Doc -> TCMT IO Doc) -> TCMT IO Doc -> TCMT IO Doc
    forall a b. (a -> b) -> a -> b
    $ Term -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM (MetaId -> Elims -> Term
    MetaV MetaId
    x Elims
    es) TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> TCMT IO Doc
    ":=" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> Term -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM Term
    v
            ]
          m Bool -> m () -> m ()
    forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
    whenM (MetaId -> m Bool
    forall a (m :: * -> *).
    (IsInstantiatedMeta a, MonadFail m, ReadTCState m) =>
    a -> m Bool
    isInstantiatedMeta MetaId
    x) (Blocker -> m ()
    forall (m :: * -> *) a. MonadBlock m => Blocker -> m a
    patternViolation Blocker
    alwaysUnblock) -- Already instantiated, retry right away
          CompareDirection
    -> MetaId
    -> Elims
    -> Term
    -> CompareAs
    -> (Term -> Term -> m ())
    -> m ()
    forall (m :: * -> *).
    MonadConversion m =>
    CompareDirection
    -> MetaId
    -> Elims
    -> Term
    -> CompareAs
    -> (Term -> Term -> m ())
    -> m ()
    assignE CompareDirection
    dir MetaId
    x Elims
    es Term
    v CompareAs
    a ((Term -> Term -> m ()) -> m ()) -> (Term -> Term -> m ()) -> m ()
    forall a b. (a -> b) -> a -> b
    $ CompareDirection -> CompareAs -> Term -> Term -> m ()
    forall (m :: * -> *).
    MonadConversion m =>
    CompareDirection -> CompareAs -> Term -> Term -> m ()
    compareAsDir CompareDirection
    dir CompareAs
    a
          VerboseKey -> Int -> TCMT IO Doc -> m ()
    forall (m :: * -> *).
    MonadDebug m =>
    VerboseKey -> Int -> TCMT IO Doc -> m ()
    reportSDoc VerboseKey
    "tc.conv.term.shortcut" Int
    50 (TCMT IO Doc -> m ()) -> TCMT IO Doc -> m ()
    forall a b. (a -> b) -> a -> b
    $
            TCMT IO Doc
    "shortcut successful" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    $$ Int -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Functor m => Int -> m Doc -> m Doc
    nest Int
    2 (TCMT IO Doc
    "result:" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> (Term -> TCMT IO Doc
    forall (m :: * -> *) a. (Applicative m, Pretty a) => a -> m Doc
    pretty (Term -> TCMT IO Doc) -> TCMT IO Term -> TCMT IO Doc
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< Term -> TCMT IO Term
    forall a (m :: * -> *). (Instantiate a, MonadReduce m) => a -> m a
    instantiate (MetaId -> Elims -> Term
    MetaV MetaId
    x Elims
    es)))
        -- Should be ok with catchError_ but catchError is much safer since we don't
        -- rethrow errors.
        orelse :: m () -> m () -> m ()
        orelse :: m () -> m () -> m ()
    orelse m ()
    m m ()
    h = m () -> (TCErr -> m ()) -> m ()
    forall e (m :: * -> *) a.
    MonadError e m =>
    m a -> (e -> m a) -> m a
    catchError m ()
    m (\TCErr
    _ -> m ()
    h)

    -- | Try to assign meta.  If meta is projected, try to eta-expand
    --   and run conversion check again.
    assignE :: (MonadConversion m)
            => CompareDirection -> MetaId -> Elims -> Term -> CompareAs -> (Term -> Term -> m ()) -> m ()
    assignE :: forall (m :: * -> *).
    MonadConversion m =>
    CompareDirection
    -> MetaId
    -> Elims
    -> Term
    -> CompareAs
    -> (Term -> Term -> m ())
    -> m ()
    assignE CompareDirection
    dir MetaId
    x Elims
    es Term
    v CompareAs
    a Term -> Term -> m ()
    comp = CompareDirection -> MetaId -> Elims -> Term -> m () -> m ()
    forall (m :: * -> *).
    (MonadMetaSolver m, MonadConstraint m, MonadError TCErr m,
     MonadDebug m, HasOptions m) =>
    CompareDirection -> MetaId -> Elims -> Term -> m () -> m ()
    assignWrapper CompareDirection
    dir MetaId
    x Elims
    es Term
    v (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $ do
      case Elims -> Maybe [Arg Term]
    forall a. [Elim' a] -> Maybe [Arg a]
    allApplyElims Elims
    es of
        Just [Arg Term]
    vs -> CompareDirection
    -> MetaId -> [Arg Term] -> Term -> CompareAs -> m ()
    forall (m :: * -> *).
    MonadMetaSolver m =>
    CompareDirection
    -> MetaId -> [Arg Term] -> Term -> CompareAs -> m ()
    assignV CompareDirection
    dir MetaId
    x [Arg Term]
    vs Term
    v CompareAs
    a
        Maybe [Arg Term]
    Nothing -> do
          VerboseKey -> Int -> TCMT IO Doc -> m ()
    forall (m :: * -> *).
    MonadDebug m =>
    VerboseKey -> Int -> TCMT IO Doc -> m ()
    reportSDoc VerboseKey
    "tc.conv.assign" Int
    30 (TCMT IO Doc -> m ()) -> TCMT IO Doc -> m ()
    forall a b. (a -> b) -> a -> b
    $ [TCMT IO Doc] -> TCMT IO Doc
    forall (m :: * -> *) (t :: * -> *).
    (Applicative m, Foldable t) =>
    t (m Doc) -> m Doc
    sep
            [ TCMT IO Doc
    "assigning to projected meta "
            , MetaId -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM MetaId
    x TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> [TCMT IO Doc] -> TCMT IO Doc
    forall (m :: * -> *) (t :: * -> *).
    (Applicative m, Foldable t) =>
    t (m Doc) -> m Doc
    sep ((Elim' Term -> TCMT IO Doc) -> Elims -> [TCMT IO Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map Elim' Term -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM Elims
    es) TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> VerboseKey -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => VerboseKey -> m Doc
    text (VerboseKey
    ":" VerboseKey -> VerboseKey -> VerboseKey
    forall a. [a] -> [a] -> [a]
    ++ CompareDirection -> VerboseKey
    forall a. Show a => a -> VerboseKey
    show CompareDirection
    dir) TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> Term -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM Term
    v
            ]
          [MetaKind] -> MetaId -> m ()
    forall (m :: * -> *).
    MonadMetaSolver m =>
    [MetaKind] -> MetaId -> m ()
    etaExpandMeta [MetaKind
    Records] MetaId
    x
          Maybe Term
    res <- MetaId -> m (Maybe Term)
    forall (m :: * -> *).
    (MonadFail m, ReadTCState m) =>
    MetaId -> m (Maybe Term)
    isInstantiatedMeta' MetaId
    x
          case Maybe Term
    res of
            Just Term
    u  -> do
              VerboseKey -> Int -> TCMT IO Doc -> m ()
    forall (m :: * -> *).
    MonadDebug m =>
    VerboseKey -> Int -> TCMT IO Doc -> m ()
    reportSDoc VerboseKey
    "tc.conv.assign" Int
    30 (TCMT IO Doc -> m ()) -> TCMT IO Doc -> m ()
    forall a b. (a -> b) -> a -> b
    $ [TCMT IO Doc] -> TCMT IO Doc
    forall (m :: * -> *) (t :: * -> *).
    (Applicative m, Foldable t) =>
    t (m Doc) -> m Doc
    sep
                [ TCMT IO Doc
    "seems like eta expansion instantiated meta "
                , MetaId -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM MetaId
    x TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> VerboseKey -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => VerboseKey -> m Doc
    text  (VerboseKey
    ":" VerboseKey -> VerboseKey -> VerboseKey
    forall a. [a] -> [a] -> [a]
    ++ CompareDirection -> VerboseKey
    forall a. Show a => a -> VerboseKey
    show CompareDirection
    dir) TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> Term -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM Term
    u
                ]
              let w :: Term
    w = Term
    u Term -> Elims -> Term
    forall t. Apply t => t -> Elims -> t
    `applyE` Elims
    es
              Term -> Term -> m ()
    comp Term
    w Term
    v
            Maybe Term
    Nothing ->  do
              VerboseKey -> Int -> VerboseKey -> m ()
    forall (m :: * -> *).
    MonadDebug m =>
    VerboseKey -> Int -> VerboseKey -> m ()
    reportSLn VerboseKey
    "tc.conv.assign" Int
    30 VerboseKey
    "eta expansion did not instantiate meta"
              Blocker -> m ()
    forall (m :: * -> *) a. MonadBlock m => Blocker -> m a
    patternViolation (Term -> Blocker
    forall t. AllMetas t => t -> Blocker
    unblockOnAnyMetaIn (MetaId -> Elims -> Term
    MetaV MetaId
    x Elims
    es)) -- nothing happened, give up

    compareAsDir :: MonadConversion m => CompareDirection -> CompareAs -> Term -> Term -> m ()
    compareAsDir :: forall (m :: * -> *).
    MonadConversion m =>
    CompareDirection -> CompareAs -> Term -> Term -> m ()
    compareAsDir CompareDirection
    dir CompareAs
    a = (Comparison -> Term -> Term -> m ())
    -> CompareDirection -> Term -> Term -> m ()
    forall a c.
    (Comparison -> a -> a -> c) -> CompareDirection -> a -> a -> c
    dirToCmp (Comparison -> CompareAs -> Term -> Term -> m ()
    forall (m :: * -> *).
    MonadConversion m =>
    Comparison -> CompareAs -> Term -> Term -> m ()
    `compareAs'` CompareAs
    a) CompareDirection
    dir

    compareAs' :: forall m. MonadConversion m => Comparison -> CompareAs -> Term -> Term -> m ()
    compareAs' :: forall (m :: * -> *).
    MonadConversion m =>
    Comparison -> CompareAs -> Term -> Term -> m ()
    compareAs' Comparison
    cmp CompareAs
    tt Term
    m Term
    n = case CompareAs
    tt of
      AsTermsOf Type
    a -> Comparison -> Type -> Term -> Term -> m ()
    forall (m :: * -> *).
    MonadConversion m =>
    Comparison -> Type -> Term -> Term -> m ()
    compareTerm' Comparison
    cmp Type
    a Term
    m Term
    n
      CompareAs
    AsSizes     -> Comparison -> Term -> Term -> m ()
    forall (m :: * -> *).
    MonadConversion m =>
    Comparison -> Term -> Term -> m ()
    compareSizes Comparison
    cmp Term
    m Term
    n
      CompareAs
    AsTypes     -> Comparison -> CompareAs -> Term -> Term -> m ()
    forall (m :: * -> *).
    MonadConversion m =>
    Comparison -> CompareAs -> Term -> Term -> m ()
    compareAtom Comparison
    cmp CompareAs
    AsTypes Term
    m Term
    n

    compareTerm' :: forall m. MonadConversion m => Comparison -> Type -> Term -> Term -> m ()
    compareTerm' :: forall (m :: * -> *).
    MonadConversion m =>
    Comparison -> Type -> Term -> Term -> m ()
    compareTerm' Comparison
    cmp Type
    a Term
    m Term
    n =
      VerboseKey -> Int -> VerboseKey -> m () -> m ()
    forall (m :: * -> *) a.
    MonadDebug m =>
    VerboseKey -> Int -> VerboseKey -> m a -> m a
    verboseBracket VerboseKey
    "tc.conv.term" Int
    20 VerboseKey
    "compareTerm" (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $ do
      (Blocker
    ba, Type
    a') <- Type -> m (Blocker, Type)
    forall a (m :: * -> *).
    (Reduce a, IsMeta a, MonadReduce m) =>
    a -> m (Blocker, a)
    reduceWithBlocker Type
    a
      (Constraint -> m () -> m ()
    forall (m :: * -> *).
    MonadConstraint m =>
    Constraint -> m () -> m ()
    catchConstraint (Comparison -> CompareAs -> Term -> Term -> Constraint
    ValueCmp Comparison
    cmp (Type -> CompareAs
    AsTermsOf Type
    a') Term
    m Term
    n) :: m () -> m ()) (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $ Blocker -> m () -> m ()
    forall (m :: * -> *) a. MonadError TCErr m => Blocker -> m a -> m a
    blockOnError Blocker
    ba (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $ do
        VerboseKey -> Int -> TCMT IO Doc -> m ()
    forall (m :: * -> *).
    MonadDebug m =>
    VerboseKey -> Int -> TCMT IO Doc -> m ()
    reportSDoc VerboseKey
    "tc.conv.term" Int
    30 (TCMT IO Doc -> m ()) -> TCMT IO Doc -> m ()
    forall a b. (a -> b) -> a -> b
    $ [TCMT IO Doc] -> TCMT IO Doc
    forall (m :: * -> *) (t :: * -> *).
    (Applicative m, Foldable t) =>
    t (m Doc) -> m Doc
    fsep
          [ TCMT IO Doc
    "compareTerm", Term -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM Term
    m, Comparison -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM Comparison
    cmp, Term -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM Term
    n, TCMT IO Doc
    ":", Type -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM Type
    a' ]
        Bool
    propIrr  <- m Bool
    forall (m :: * -> *). HasOptions m => m Bool
    isPropEnabled
        Bool
    isSize   <- Maybe BoundedSize -> Bool
    forall a. Maybe a -> Bool
    isJust (Maybe BoundedSize -> Bool) -> m (Maybe BoundedSize) -> m Bool
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Type -> m (Maybe BoundedSize)
    forall a (m :: * -> *).
    (IsSizeType a, HasOptions m, HasBuiltins m) =>
    a -> m (Maybe BoundedSize)
    isSizeType Type
    a'
        (Blocker
    bs, Sort
    s)  <- Sort -> m (Blocker, Sort)
    forall a (m :: * -> *).
    (Reduce a, IsMeta a, MonadReduce m) =>
    a -> m (Blocker, a)
    reduceWithBlocker (Sort -> m (Blocker, Sort)) -> Sort -> m (Blocker, Sort)
    forall a b. (a -> b) -> a -> b
    $ Type -> Sort
    forall a. LensSort a => a -> Sort
    getSort Type
    a'
        Maybe Term
    mlvl     <- VerboseKey -> m (Maybe Term)
    forall (m :: * -> *). HasBuiltins m => VerboseKey -> m (Maybe Term)
    getBuiltin' VerboseKey
    builtinLevel
        VerboseKey -> Int -> TCMT IO Doc -> m ()
    forall (m :: * -> *).
    MonadDebug m =>
    VerboseKey -> Int -> TCMT IO Doc -> m ()
    reportSDoc VerboseKey
    "tc.conv.level" Int
    60 (TCMT IO Doc -> m ()) -> TCMT IO Doc -> m ()
    forall a b. (a -> b) -> a -> b
    $ Int -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Functor m => Int -> m Doc -> m Doc
    nest Int
    2 (TCMT IO Doc -> TCMT IO Doc) -> TCMT IO Doc -> TCMT IO Doc
    forall a b. (a -> b) -> a -> b
    $ [TCMT IO Doc] -> TCMT IO Doc
    forall (m :: * -> *) (t :: * -> *).
    (Applicative m, Foldable t) =>
    t (m Doc) -> m Doc
    sep
          [ TCMT IO Doc
    "a'   =" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> Type -> TCMT IO Doc
    forall (m :: * -> *) a. (Applicative m, Pretty a) => a -> m Doc
    pretty Type
    a'
          , TCMT IO Doc
    "mlvl =" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> Maybe Term -> TCMT IO Doc
    forall (m :: * -> *) a. (Applicative m, Pretty a) => a -> m Doc
    pretty Maybe Term
    mlvl
          , VerboseKey -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => VerboseKey -> m Doc
    text (VerboseKey -> TCMT IO Doc) -> VerboseKey -> TCMT IO Doc
    forall a b. (a -> b) -> a -> b
    $ VerboseKey
    "(Just (unEl a') == mlvl) = " VerboseKey -> VerboseKey -> VerboseKey
    forall a. [a] -> [a] -> [a]
    ++ Bool -> VerboseKey
    forall a. Show a => a -> VerboseKey
    show (Term -> Maybe Term
    forall a. a -> Maybe a
    Just (Type -> Term
    forall t a. Type'' t a -> a
    unEl Type
    a') Maybe Term -> Maybe Term -> Bool
    forall a. Eq a => a -> a -> Bool
    == Maybe Term
    mlvl)
          ]
        Blocker -> m () -> m ()
    forall (m :: * -> *) a. MonadError TCErr m => Blocker -> m a -> m a
    blockOnError Blocker
    bs (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $ case Sort
    s of
          Prop{} | Bool
    propIrr -> Type -> Term -> Term -> m ()
    forall (m :: * -> *).
    MonadConversion m =>
    Type -> Term -> Term -> m ()
    compareIrrelevant Type
    a' Term
    m Term
    n
          Sort
    _    | Bool
    isSize   -> Comparison -> Term -> Term -> m ()
    forall (m :: * -> *).
    MonadConversion m =>
    Comparison -> Term -> Term -> m ()
    compareSizes Comparison
    cmp Term
    m Term
    n
          Sort
    _               -> case Type -> Term
    forall t a. Type'' t a -> a
    unEl Type
    a' of
            Term
    a | Term -> Maybe Term
    forall a. a -> Maybe a
    Just Term
    a Maybe Term -> Maybe Term -> Bool
    forall a. Eq a => a -> a -> Bool
    == Maybe Term
    mlvl -> do
              Level
    a <- Term -> m Level
    forall (m :: * -> *). PureTCM m => Term -> m Level
    levelView Term
    m
              Level
    b <- Term -> m Level
    forall (m :: * -> *). PureTCM m => Term -> m Level
    levelView Term
    n
              Level -> Level -> m ()
    forall (m :: * -> *). MonadConversion m => Level -> Level -> m ()
    equalLevel Level
    a Level
    b
            a :: Term
    a@Pi{}    -> MonadConversion m => Sort -> Term -> Term -> Term -> m ()
    Sort -> Term -> Term -> Term -> m ()
    equalFun Sort
    s Term
    a Term
    m Term
    n
            Lam ArgInfo
    _ Abs Term
    _   -> m ()
    forall a. HasCallStack => a
    __IMPOSSIBLE__
            Def QName
    r Elims
    es  -> do
              Bool
    isrec <- QName -> m Bool
    forall (m :: * -> *). HasConstInfo m => QName -> m Bool
    isEtaRecord QName
    r
              if Bool
    isrec
                then do
                  Signature
    sig <- m Signature
    forall (m :: * -> *). ReadTCState m => m Signature
    getSignature
                  let ps :: [Arg Term]
    ps = [Arg Term] -> Maybe [Arg Term] -> [Arg Term]
    forall a. a -> Maybe a -> a
    fromMaybe [Arg Term]
    forall a. HasCallStack => a
    __IMPOSSIBLE__ (Maybe [Arg Term] -> [Arg Term]) -> Maybe [Arg Term] -> [Arg Term]
    forall a b. (a -> b) -> a -> b
    $ Elims -> Maybe [Arg Term]
    forall a. [Elim' a] -> Maybe [Arg a]
    allApplyElims Elims
    es
                  -- Andreas, 2010-10-11: allowing neutrals to be blocked things does not seem
                  -- to change Agda's behavior
                  --    isNeutral Blocked{}          = False
                      isNeutral :: Blocked' t Term -> m Bool
    isNeutral (NotBlocked NotBlocked' t
    _ Con{}) = Bool -> m Bool
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    False
                  -- Andreas, 2013-09-18 / 2015-06-29: a Def by copatterns is
                  -- not neutral if it is blocked (there can be missing projections
                  -- to trigger a reduction.
                      isNeutral (NotBlocked NotBlocked' t
    r (Def QName
    q Elims
    _)) = do    -- Andreas, 2014-12-06 optimize this using r !!
                        Bool -> Bool
    not (Bool -> Bool) -> m Bool -> m Bool
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> QName -> m Bool
    forall (m :: * -> *). HasConstInfo m => QName -> m Bool
    usesCopatterns QName
    q -- a def by copattern can reduce if projected
                      isNeutral Blocked' t Term
    _                   = Bool -> m Bool
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    True
                      isMeta :: Blocked' t Term -> Bool
    isMeta Blocked' t Term
    b = case Blocked' t Term -> Term
    forall t a. Blocked' t a -> a
    ignoreBlocking Blocked' t Term
    b of
                                   MetaV{} -> Bool
    True
                                   Term
    _       -> Bool
    False

                  VerboseKey -> Int -> TCMT IO Doc -> m ()
    forall (m :: * -> *).
    MonadDebug m =>
    VerboseKey -> Int -> TCMT IO Doc -> m ()
    reportSDoc VerboseKey
    "tc.conv.term" Int
    30 (TCMT IO Doc -> m ()) -> TCMT IO Doc -> m ()
    forall a b. (a -> b) -> a -> b
    $ Type -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM Type
    a TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> TCMT IO Doc
    "is eta record type"
                  Blocked Term
    m <- Term -> m (Blocked Term)
    forall a (m :: * -> *).
    (Reduce a, MonadReduce m) =>
    a -> m (Blocked a)
    reduceB Term
    m
                  Bool
    mNeutral <- Blocked Term -> m Bool
    forall {m :: * -> *} {t}.
    HasConstInfo m =>
    Blocked' t Term -> m Bool
    isNeutral Blocked Term
    m
                  Blocked Term
    n <- Term -> m (Blocked Term)
    forall a (m :: * -> *).
    (Reduce a, MonadReduce m) =>
    a -> m (Blocked a)
    reduceB Term
    n
                  Bool
    nNeutral <- Blocked Term -> m Bool
    forall {m :: * -> *} {t}.
    HasConstInfo m =>
    Blocked' t Term -> m Bool
    isNeutral Blocked Term
    n
                  case (Blocked Term
    m, Blocked Term
    n) of
                    (Blocked Term, Blocked Term)
    _ | Blocked Term -> Bool
    forall {t}. Blocked' t Term -> Bool
    isMeta Blocked Term
    m Bool -> Bool -> Bool
    || Blocked Term -> Bool
    forall {t}. Blocked' t Term -> Bool
    isMeta Blocked Term
    n ->
                        Comparison -> CompareAs -> Term -> Term -> m ()
    forall (m :: * -> *).
    MonadConversion m =>
    Comparison -> CompareAs -> Term -> Term -> m ()
    compareAtom Comparison
    cmp (Type -> CompareAs
    AsTermsOf Type
    a') (Blocked Term -> Term
    forall t a. Blocked' t a -> a
    ignoreBlocking Blocked Term
    m) (Blocked Term -> Term
    forall t a. Blocked' t a -> a
    ignoreBlocking Blocked Term
    n)

                    (Blocked Term, Blocked Term)
    _ | Bool
    mNeutral Bool -> Bool -> Bool
    && Bool
    nNeutral -> do
                        -- Andreas 2011-03-23: (fixing issue 396)
                        -- if we are dealing with a singleton record,
                        -- we can succeed immediately
                        m Bool -> m () -> m () -> m ()
    forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
    ifM (QName -> [Arg Term] -> m Bool
    forall (m :: * -> *).
    (PureTCM m, MonadBlock m) =>
    QName -> [Arg Term] -> m Bool
    isSingletonRecordModuloRelevance QName
    r [Arg Term]
    ps) (() -> m ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()) (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $
                          -- do not eta-expand if comparing two neutrals
                          Comparison -> CompareAs -> Term -> Term -> m ()
    forall (m :: * -> *).
    MonadConversion m =>
    Comparison -> CompareAs -> Term -> Term -> m ()
    compareAtom Comparison
    cmp (Type -> CompareAs
    AsTermsOf Type
    a') (Blocked Term -> Term
    forall t a. Blocked' t a -> a
    ignoreBlocking Blocked Term
    m) (Blocked Term -> Term
    forall t a. Blocked' t a -> a
    ignoreBlocking Blocked Term
    n)
                    (Blocked Term, Blocked Term)
    _ -> do
                      (Telescope
    tel, [Arg Term]
    m') <- QName -> [Arg Term] -> Term -> m (Telescope, [Arg Term])
    forall (m :: * -> *).
    (HasConstInfo m, MonadDebug m, ReadTCState m) =>
    QName -> [Arg Term] -> Term -> m (Telescope, [Arg Term])
    etaExpandRecord QName
    r [Arg Term]
    ps (Term -> m (Telescope, [Arg Term]))
    -> Term -> m (Telescope, [Arg Term])
    forall a b. (a -> b) -> a -> b
    $ Blocked Term -> Term
    forall t a. Blocked' t a -> a
    ignoreBlocking Blocked Term
    m
                      (Telescope
    _  , [Arg Term]
    n') <- QName -> [Arg Term] -> Term -> m (Telescope, [Arg Term])
    forall (m :: * -> *).
    (HasConstInfo m, MonadDebug m, ReadTCState m) =>
    QName -> [Arg Term] -> Term -> m (Telescope, [Arg Term])
    etaExpandRecord QName
    r [Arg Term]
    ps (Term -> m (Telescope, [Arg Term]))
    -> Term -> m (Telescope, [Arg Term])
    forall a b. (a -> b) -> a -> b
    $ Blocked Term -> Term
    forall t a. Blocked' t a -> a
    ignoreBlocking Blocked Term
    n
                      -- No subtyping on record terms
                      ConHead
    c <- QName -> m ConHead
    forall (m :: * -> *).
    (HasConstInfo m, ReadTCState m, MonadError TCErr m) =>
    QName -> m ConHead
    getRecordConstructor QName
    r
                      -- Record constructors are covariant (see test/succeed/CovariantConstructors).
                      [Polarity]
    -> [IsForced] -> Type -> Term -> [Arg Term] -> [Arg Term] -> m ()
    forall (m :: * -> *).
    MonadConversion m =>
    [Polarity]
    -> [IsForced] -> Type -> Term -> [Arg Term] -> [Arg Term] -> m ()
    compareArgs (Polarity -> [Polarity]
    forall a. a -> [a]
    repeat (Polarity -> [Polarity]) -> Polarity -> [Polarity]
    forall a b. (a -> b) -> a -> b
    $ Comparison -> Polarity
    polFromCmp Comparison
    cmp) [] (Telescope -> Type -> Type
    telePi_ Telescope
    tel Type
    HasCallStack => Type
    __DUMMY_TYPE__) (ConHead -> ConInfo -> Elims -> Term
    Con ConHead
    c ConInfo
    ConOSystem []) [Arg Term]
    m' [Arg Term]
    n'

                else (do PathView
    pathview <- Type -> m PathView
    forall (m :: * -> *). HasBuiltins m => Type -> m PathView
    pathView Type
    a'
                         MonadConversion m => PathView -> Type -> Term -> Term -> m ()
    PathView -> Type -> Term -> Term -> m ()
    equalPath PathView
    pathview Type
    a' Term
    m Term
    n)
            Term
    _ -> Comparison -> CompareAs -> Term -> Term -> m ()
    forall (m :: * -> *).
    MonadConversion m =>
    Comparison -> CompareAs -> Term -> Term -> m ()
    compareAtom Comparison
    cmp (Type -> CompareAs
    AsTermsOf Type
    a') Term
    m Term
    n
      where
        -- equality at function type (accounts for eta)
        equalFun :: (MonadConversion m) => Sort -> Term -> Term -> Term -> m ()
        equalFun :: MonadConversion m => Sort -> Term -> Term -> Term -> m ()
    equalFun Sort
    s a :: Term
    a@(Pi Dom Type
    dom Abs Type
    b) Term
    m Term
    n | Dom Type -> Bool
    forall t e. Dom' t e -> Bool
    domFinite Dom Type
    dom = do
           Maybe QName
    mp <- (Term -> QName) -> Maybe Term -> Maybe QName
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Term -> QName
    getPrimName (Maybe Term -> Maybe QName) -> m (Maybe Term) -> m (Maybe QName)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> VerboseKey -> m (Maybe Term)
    forall (m :: * -> *). HasBuiltins m => VerboseKey -> m (Maybe Term)
    getBuiltin' VerboseKey
    builtinIsOne
           case Type -> Term
    forall t a. Type'' t a -> a
    unEl (Type -> Term) -> Type -> Term
    forall a b. (a -> b) -> a -> b
    $ Dom Type -> Type
    forall t e. Dom' t e -> e
    unDom Dom Type
    dom of
              Def QName
    q [Apply Arg Term
    phi]
                  | QName -> Maybe QName
    forall a. a -> Maybe a
    Just QName
    q Maybe QName -> Maybe QName -> Bool
    forall a. Eq a => a -> a -> Bool
    == Maybe QName
    mp -> Comparison -> Term -> Type -> Term -> Term -> m ()
    forall (m :: * -> *).
    MonadConversion m =>
    Comparison -> Term -> Type -> Term -> Term -> m ()
    compareTermOnFace Comparison
    cmp (Arg Term -> Term
    forall e. Arg e -> e
    unArg Arg Term
    phi) (Sort -> Term -> Type
    forall t a. Sort' t -> a -> Type'' t a
    El Sort
    s (Dom Type -> Abs Type -> Term
    Pi (Dom Type
    dom {domFinite :: Bool
    domFinite = Bool
    False}) Abs Type
    b)) Term
    m Term
    n
              Term
    _                  -> MonadConversion m => Sort -> Term -> Term -> Term -> m ()
    Sort -> Term -> Term -> Term -> m ()
    equalFun Sort
    s (Dom Type -> Abs Type -> Term
    Pi (Dom Type
    dom{domFinite :: Bool
    domFinite = Bool
    False}) Abs Type
    b) Term
    m Term
    n
        equalFun Sort
    _ (Pi dom :: Dom Type
    dom@Dom{domInfo :: forall t e. Dom' t e -> ArgInfo
    domInfo = ArgInfo
    info} Abs Type
    b) Term
    m Term
    n | Bool -> Bool
    not (Bool -> Bool) -> Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $ Dom Type -> Bool
    forall t e. Dom' t e -> Bool
    domFinite Dom Type
    dom = do
            let name :: VerboseKey
    name = [Suggestion] -> VerboseKey
    suggests [ Abs Type -> Suggestion
    forall a. Suggest a => a -> Suggestion
    Suggestion Abs Type
    b , Term -> Suggestion
    forall a. Suggest a => a -> Suggestion
    Suggestion Term
    m , Term -> Suggestion
    forall a. Suggest a => a -> Suggestion
    Suggestion Term
    n ]
            (VerboseKey, Dom Type) -> m () -> m ()
    forall b (m :: * -> *) a.
    (AddContext b, MonadAddContext m) =>
    b -> m a -> m a
    addContext (VerboseKey
    name, Dom Type
    dom) (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $ Comparison -> Type -> Term -> Term -> m ()
    forall (m :: * -> *).
    MonadConversion m =>
    Comparison -> Type -> Term -> Term -> m ()
    compareTerm Comparison
    cmp (Abs Type -> Type
    forall a. Subst a => Abs a -> a
    absBody Abs Type
    b) Term
    m' Term
    n'
          where
            (Term
    m',Term
    n') = Int -> (Term, Term) -> (Term, Term)
    forall a. Subst a => Int -> a -> a
    raise Int
    1 (Term
    m,Term
    n) (Term, Term) -> [Arg Term] -> (Term, Term)
    forall t. Apply t => t -> [Arg Term] -> t
    `apply` [ArgInfo -> Term -> Arg Term
    forall e. ArgInfo -> e -> Arg e
    Arg ArgInfo
    info (Term -> Arg Term) -> Term -> Arg Term
    forall a b. (a -> b) -> a -> b
    $ Int -> Term
    var Int
    0]
        equalFun Sort
    _ Term
    _ Term
    _ Term
    _ = m ()
    forall a. HasCallStack => a
    __IMPOSSIBLE__

        equalPath :: (MonadConversion m) => PathView -> Type -> Term -> Term -> m ()
        equalPath :: MonadConversion m => PathView -> Type -> Term -> Term -> m ()
    equalPath (PathType Sort
    s QName
    _ Arg Term
    l Arg Term
    a Arg Term
    x Arg Term
    y) Type
    _ Term
    m Term
    n = do
            let name :: VerboseKey
    name = VerboseKey
    "i" :: String
            Type
    interval <- m Term -> m Type
    forall (m :: * -> *). Functor m => m Term -> m Type
    el m Term
    forall (m :: * -> *).
    (HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
    m Term
    primInterval
            let (Term
    m',Term
    n') = Int -> (Term, Term) -> (Term, Term)
    forall a. Subst a => Int -> a -> a
    raise Int
    1 (Term
    m, Term
    n) (Term, Term) -> Elims -> (Term, Term)
    forall t. Apply t => t -> Elims -> t
    `applyE` [Term -> Term -> Term -> Elim' Term
    forall a. a -> a -> a -> Elim' a
    IApply (Int -> Term -> Term
    forall a. Subst a => Int -> a -> a
    raise Int
    1 (Term -> Term) -> Term -> Term
    forall a b. (a -> b) -> a -> b
    $ Arg Term -> Term
    forall e. Arg e -> e
    unArg Arg Term
    x) (Int -> Term -> Term
    forall a. Subst a => Int -> a -> a
    raise Int
    1 (Term -> Term) -> Term -> Term
    forall a b. (a -> b) -> a -> b
    $ Arg Term -> Term
    forall e. Arg e -> e
    unArg Arg Term
    y) (Int -> Term
    var Int
    0)]
            (VerboseKey, Dom Type) -> m () -> m ()
    forall b (m :: * -> *) a.
    (AddContext b, MonadAddContext m) =>
    b -> m a -> m a
    addContext (VerboseKey
    name, Type -> Dom Type
    forall a. a -> Dom a
    defaultDom Type
    interval) (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $ Comparison -> Type -> Term -> Term -> m ()
    forall (m :: * -> *).
    MonadConversion m =>
    Comparison -> Type -> Term -> Term -> m ()
    compareTerm Comparison
    cmp (Sort -> Term -> Type
    forall t a. Sort' t -> a -> Type'' t a
    El (Int -> Sort -> Sort
    forall a. Subst a => Int -> a -> a
    raise Int
    1 Sort
    s) (Term -> Type) -> Term -> Type
    forall a b. (a -> b) -> a -> b
    $ Int -> Term -> Term
    forall a. Subst a => Int -> a -> a
    raise Int
    1 (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` [Term -> Arg Term
    forall e. e -> Arg e
    argN (Term -> Arg Term) -> Term -> Arg Term
    forall a b. (a -> b) -> a -> b
    $ Int -> Term
    var Int
    0]) Term
    m' Term
    n'
        equalPath OType{} Type
    a' Term
    m Term
    n = Type -> Term -> Term -> m ()
    cmpDef Type
    a' Term
    m Term
    n

        cmpDef :: Type -> Term -> Term -> m ()
    cmpDef a' :: Type
    a'@(El Sort
    s Term
    ty) Term
    m Term
    n = do
           Maybe QName
    mI     <- VerboseKey -> m (Maybe QName)
    forall (m :: * -> *).
    HasBuiltins m =>
    VerboseKey -> m (Maybe QName)
    getBuiltinName'   VerboseKey
    builtinInterval
           Maybe QName
    mIsOne <- VerboseKey -> m (Maybe QName)
    forall (m :: * -> *).
    HasBuiltins m =>
    VerboseKey -> m (Maybe QName)
    getBuiltinName'   VerboseKey
    builtinIsOne
           Maybe QName
    mGlue  <- VerboseKey -> m (Maybe QName)
    forall (m :: * -> *).
    HasBuiltins m =>
    VerboseKey -> m (Maybe QName)
    getPrimitiveName' VerboseKey
    builtinGlue
           Maybe QName
    mHComp <- VerboseKey -> m (Maybe QName)
    forall (m :: * -> *).
    HasBuiltins m =>
    VerboseKey -> m (Maybe QName)
    getPrimitiveName' VerboseKey
    builtinHComp
           Maybe QName
    mSub   <- VerboseKey -> m (Maybe QName)
    forall (m :: * -> *).
    HasBuiltins m =>
    VerboseKey -> m (Maybe QName)
    getBuiltinName' VerboseKey
    builtinSub
           Maybe Term
    mUnglueU <- VerboseKey -> m (Maybe Term)
    forall (m :: * -> *). HasBuiltins m => VerboseKey -> m (Maybe Term)
    getPrimitiveTerm' VerboseKey
    builtin_unglueU
           Maybe Term
    mSubIn   <- VerboseKey -> m (Maybe Term)
    forall (m :: * -> *). HasBuiltins m => VerboseKey -> m (Maybe Term)
    getPrimitiveTerm' VerboseKey
    builtinSubIn
           case Term
    ty of
             Def QName
    q Elims
    es | QName -> Maybe QName
    forall a. a -> Maybe a
    Just QName
    q Maybe QName -> Maybe QName -> Bool
    forall a. Eq a => a -> a -> Bool
    == Maybe QName
    mIsOne -> () -> m ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
             Def QName
    q Elims
    es | QName -> Maybe QName
    forall a. a -> Maybe a
    Just QName
    q Maybe QName -> Maybe QName -> Bool
    forall a. Eq a => a -> a -> Bool
    == Maybe QName
    mGlue, Just args :: [Arg Term]
    args@(Arg Term
    l:Arg Term
    _:Arg Term
    a:Arg Term
    phi:[Arg Term]
    _) <- Elims -> Maybe [Arg Term]
    forall a. [Elim' a] -> Maybe [Arg a]
    allApplyElims Elims
    es -> do
                  Type
    aty <- m Term -> m Term -> m Type
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Type
    el' (Term -> m Term
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Term -> m Term) -> Term -> m Term
    forall a b. (a -> b) -> a -> b
    $ Arg Term -> Term
    forall e. Arg e -> e
    unArg Arg Term
    l) (Term -> m Term
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Term -> m Term) -> Term -> m Term
    forall a b. (a -> b) -> a -> b
    $ Arg Term -> Term
    forall e. Arg e -> e
    unArg Arg Term
    a)
                  Term
    unglue <- m Term
    forall (m :: * -> *).
    (HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
    m Term
    prim_unglue
                  let mkUnglue :: Term -> Term
    mkUnglue Term
    m = Term -> [Arg Term] -> Term
    forall t. Apply t => t -> [Arg Term] -> t
    apply Term
    unglue ([Arg Term] -> Term) -> [Arg Term] -> Term
    forall a b. (a -> b) -> a -> b
    $ (Arg Term -> Arg Term) -> [Arg Term] -> [Arg Term]
    forall a b. (a -> b) -> [a] -> [b]
    map (Hiding -> Arg Term -> Arg Term
    forall a. LensHiding a => Hiding -> a -> a
    setHiding Hiding
    Hidden) [Arg Term]
    args [Arg Term] -> [Arg Term] -> [Arg Term]
    forall a. [a] -> [a] -> [a]
    ++ [Term -> Arg Term
    forall e. e -> Arg e
    argN Term
    m]
                  VerboseKey -> Int -> TCMT IO Doc -> m ()
    forall (m :: * -> *).
    MonadDebug m =>
    VerboseKey -> Int -> TCMT IO Doc -> m ()
    reportSDoc VerboseKey
    "conv.glue" Int
    20 (TCMT IO Doc -> m ()) -> TCMT IO Doc -> m ()
    forall a b. (a -> b) -> a -> b
    $ (Type, Term, Term) -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM (Type
    aty,Term -> Term
    mkUnglue Term
    m,Term -> Term
    mkUnglue Term
    n)
                  Comparison -> Term -> Type -> Term -> Term -> m ()
    forall (m :: * -> *).
    MonadConversion m =>
    Comparison -> Term -> Type -> Term -> Term -> m ()
    compareTermOnFace Comparison
    cmp (Arg Term -> Term
    forall e. Arg e -> e
    unArg Arg Term
    phi) Type
    a' Term
    m Term
    n
                  Comparison -> Type -> Term -> Term -> m ()
    forall (m :: * -> *).
    MonadConversion m =>
    Comparison -> Type -> Term -> Term -> m ()
    compareTerm Comparison
    cmp Type
    aty (Term -> Term
    mkUnglue Term
    m) (Term -> Term
    mkUnglue Term
    n)
             Def QName
    q Elims
    es | QName -> Maybe QName
    forall a. a -> Maybe a
    Just QName
    q Maybe QName -> Maybe QName -> Bool
    forall a. Eq a => a -> a -> Bool
    == Maybe QName
    mHComp, Just (Arg Term
    sl:Arg Term
    s:args :: [Arg Term]
    args@[Arg Term
    phi,Arg Term
    u,Arg Term
    u0]) <- Elims -> Maybe [Arg Term]
    forall a. [Elim' a] -> Maybe [Arg a]
    allApplyElims Elims
    es
                      , Sort (Type Level
    lvl) <- Arg Term -> Term
    forall e. Arg e -> e
    unArg Arg Term
    s
                      , Just Term
    unglueU <- Maybe Term
    mUnglueU, Just Term
    subIn <- Maybe Term
    mSubIn
                      -> do
                  let l :: Term
    l = Level -> Term
    Level Level
    lvl
                  Type
    ty <- m Term -> m Term -> m Type
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Type
    el' (Term -> m Term
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Term -> m Term) -> Term -> m Term
    forall a b. (a -> b) -> a -> b
    $ Term
    l) (Term -> m Term
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Term -> m Term) -> Term -> m Term
    forall a b. (a -> b) -> a -> b
    $ Arg Term -> Term
    forall e. Arg e -> e
    unArg Arg Term
    u0)
                  let bA :: Term
    bA = Term
    subIn Term -> [Arg Term] -> Term
    forall t. Apply t => t -> [Arg Term] -> t
    `apply` [Arg Term
    sl,Arg Term
    s,Arg Term
    phi,Arg Term
    u0]
                  let mkUnglue :: Term -> Term
    mkUnglue Term
    m = Term -> [Arg Term] -> Term
    forall t. Apply t => t -> [Arg Term] -> t
    apply Term
    unglueU ([Arg Term] -> Term) -> [Arg Term] -> Term
    forall a b. (a -> b) -> a -> b
    $ [Term -> Arg Term
    forall e. e -> Arg e
    argH Term
    l] [Arg Term] -> [Arg Term] -> [Arg Term]
    forall a. [a] -> [a] -> [a]
    ++ (Arg Term -> Arg Term) -> [Arg Term] -> [Arg Term]
    forall a b. (a -> b) -> [a] -> [b]
    map (Hiding -> Arg Term -> Arg Term
    forall a. LensHiding a => Hiding -> a -> a
    setHiding Hiding
    Hidden) [Arg Term
    phi,Arg Term
    u]  [Arg Term] -> [Arg Term] -> [Arg Term]
    forall a. [a] -> [a] -> [a]
    ++ [Term -> Arg Term
    forall e. e -> Arg e
    argH Term
    bA,Term -> Arg Term
    forall e. e -> Arg e
    argN Term
    m]
                  VerboseKey -> Int -> TCMT IO Doc -> m ()
    forall (m :: * -> *).
    MonadDebug m =>
    VerboseKey -> Int -> TCMT IO Doc -> m ()
    reportSDoc VerboseKey
    "conv.hcompU" Int
    20 (TCMT IO Doc -> m ()) -> TCMT IO Doc -> m ()
    forall a b. (a -> b) -> a -> b
    $ (Type, Term, Term) -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM (Type
    ty,Term -> Term
    mkUnglue Term
    m,Term -> Term
    mkUnglue Term
    n)
                  Comparison -> Term -> Type -> Term -> Term -> m ()
    forall (m :: * -> *).
    MonadConversion m =>
    Comparison -> Term -> Type -> Term -> Term -> m ()
    compareTermOnFace Comparison
    cmp (Arg Term -> Term
    forall e. Arg e -> e
    unArg Arg Term
    phi) Type
    ty Term
    m Term
    n
                  Comparison -> Type -> Term -> Term -> m ()
    forall (m :: * -> *).
    MonadConversion m =>
    Comparison -> Type -> Term -> Term -> m ()
    compareTerm Comparison
    cmp Type
    ty (Term -> Term
    mkUnglue Term
    m) (Term -> Term
    mkUnglue Term
    n)
             Def QName
    q Elims
    es | QName -> Maybe QName
    forall a. a -> Maybe a
    Just QName
    q Maybe QName -> Maybe QName -> Bool
    forall a. Eq a => a -> a -> Bool
    == Maybe QName
    mSub, Just args :: [Arg Term]
    args@(Arg Term
    l:Arg Term
    a:[Arg Term]
    _) <- Elims -> Maybe [Arg Term]
    forall a. [Elim' a] -> Maybe [Arg a]
    allApplyElims Elims
    es -> do
                  Type
    ty <- m Term -> m Term -> m Type
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Type
    el' (Term -> m Term
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Term -> m Term) -> Term -> m Term
    forall a b. (a -> b) -> a -> b
    $ Arg Term -> Term
    forall e. Arg e -> e
    unArg Arg Term
    l) (Term -> m Term
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Term -> m Term) -> Term -> m Term
    forall a b. (a -> b) -> a -> b
    $ Arg Term -> Term
    forall e. Arg e -> e
    unArg Arg Term
    a)
                  Term
    out <- m Term
    forall (m :: * -> *).
    (HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
    m Term
    primSubOut
                  let mkOut :: Term -> Term
    mkOut Term
    m = Term -> [Arg Term] -> Term
    forall t. Apply t => t -> [Arg Term] -> t
    apply Term
    out ([Arg Term] -> Term) -> [Arg Term] -> Term
    forall a b. (a -> b) -> a -> b
    $ (Arg Term -> Arg Term) -> [Arg Term] -> [Arg Term]
    forall a b. (a -> b) -> [a] -> [b]
    map (Hiding -> Arg Term -> Arg Term
    forall a. LensHiding a => Hiding -> a -> a
    setHiding Hiding
    Hidden) [Arg Term]
    args [Arg Term] -> [Arg Term] -> [Arg Term]
    forall a. [a] -> [a] -> [a]
    ++ [Term -> Arg Term
    forall e. e -> Arg e
    argN Term
    m]
                  Comparison -> Type -> Term -> Term -> m ()
    forall (m :: * -> *).
    MonadConversion m =>
    Comparison -> Type -> Term -> Term -> m ()
    compareTerm Comparison
    cmp Type
    ty (Term -> Term
    mkOut Term
    m) (Term -> Term
    mkOut Term
    n)
             Def QName
    q [] | QName -> Maybe QName
    forall a. a -> Maybe a
    Just QName
    q Maybe QName -> Maybe QName -> Bool
    forall a. Eq a => a -> a -> Bool
    == Maybe QName
    mI -> Comparison -> Type -> Term -> Term -> m ()
    forall (m :: * -> *).
    MonadConversion m =>
    Comparison -> Type -> Term -> Term -> m ()
    compareInterval Comparison
    cmp Type
    a' Term
    m Term
    n
             Term
    _ -> Comparison -> CompareAs -> Term -> Term -> m ()
    forall (m :: * -> *).
    MonadConversion m =>
    Comparison -> CompareAs -> Term -> Term -> m ()
    compareAtom Comparison
    cmp (Type -> CompareAs
    AsTermsOf Type
    a') Term
    m Term
    n

    compareAtomDir :: MonadConversion m => CompareDirection -> CompareAs -> Term -> Term -> m ()
    compareAtomDir :: forall (m :: * -> *).
    MonadConversion m =>
    CompareDirection -> CompareAs -> Term -> Term -> m ()
    compareAtomDir CompareDirection
    dir CompareAs
    a = (Comparison -> Term -> Term -> m ())
    -> CompareDirection -> Term -> Term -> m ()
    forall a c.
    (Comparison -> a -> a -> c) -> CompareDirection -> a -> a -> c
    dirToCmp (Comparison -> CompareAs -> Term -> Term -> m ()
    forall (m :: * -> *).
    MonadConversion m =>
    Comparison -> CompareAs -> Term -> Term -> m ()
    `compareAtom` CompareAs
    a) CompareDirection
    dir

    -- | Compute the head type of an elimination. For projection-like functions
    --   this requires inferring the type of the principal argument.
    computeElimHeadType :: MonadConversion m => QName -> Elims -> Elims -> m Type
    computeElimHeadType :: forall (m :: * -> *).
    MonadConversion m =>
    QName -> Elims -> Elims -> m Type
    computeElimHeadType QName
    f Elims
    es Elims
    es' = do
      Definition
    def <- QName -> m Definition
    forall (m :: * -> *). HasConstInfo m => QName -> m Definition
    getConstInfo QName
    f
      -- To compute the type @a@ of a projection-like @f@,
      -- we have to infer the type of its first argument.
      if Definition -> Int
    projectionArgs Definition
    def Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    0 then Type -> m Type
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Type -> m Type) -> Type -> m Type
    forall a b. (a -> b) -> a -> b
    $ Definition -> Type
    defType Definition
    def else do
        -- Find a first argument to @f@.
        let arg :: Arg Term
    arg = case (Elims
    es, Elims
    es') of
                  (Apply Arg Term
    arg : Elims
    _, Elims
    _) -> Arg Term
    arg
                  (Elims
    _, Apply Arg Term
    arg : Elims
    _) -> Arg Term
    arg
                  (Elims, Elims)
    _ -> Arg Term
    forall a. HasCallStack => a
    __IMPOSSIBLE__
        -- Infer its type.
        VerboseKey -> Int -> TCMT IO Doc -> m ()
    forall (m :: * -> *).
    MonadDebug m =>
    VerboseKey -> Int -> TCMT IO Doc -> m ()
    reportSDoc VerboseKey
    "tc.conv.infer" Int
    30 (TCMT IO Doc -> m ()) -> TCMT IO Doc -> m ()
    forall a b. (a -> b) -> a -> b
    $
          TCMT IO Doc
    "inferring type of internal arg: " TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> Arg Term -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM Arg Term
    arg
        Type
    targ <- Term -> m Type
    forall (m :: * -> *). MonadCheckInternal m => Term -> m Type
    infer (Term -> m Type) -> Term -> m Type
    forall a b. (a -> b) -> a -> b
    $ Arg Term -> Term
    forall e. Arg e -> e
    unArg Arg Term
    arg
        VerboseKey -> Int -> TCMT IO Doc -> m ()
    forall (m :: * -> *).
    MonadDebug m =>
    VerboseKey -> Int -> TCMT IO Doc -> m ()
    reportSDoc VerboseKey
    "tc.conv.infer" Int
    30 (TCMT IO Doc -> m ()) -> TCMT IO Doc -> m ()
    forall a b. (a -> b) -> a -> b
    $
          TCMT IO Doc
    "inferred type: " TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> Type -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM Type
    targ
        -- getDefType wants the argument type reduced.
        -- Andreas, 2016-02-09, Issue 1825: The type of arg might be
        -- a meta-variable, e.g. in interactive development.
        -- In this case, we postpone.
        Type
    targ <- Type -> m Type
    forall (m :: * -> *) t.
    (MonadReduce m, MonadBlock m, IsMeta t, Reduce t) =>
    t -> m t
    abortIfBlocked Type
    targ
        m Type -> m (Maybe Type) -> m Type
    forall (m :: * -> *) a. Monad m => m a -> m (Maybe a) -> m a
    fromMaybeM m Type
    forall a. HasCallStack => a
    __IMPOSSIBLE__ (m (Maybe Type) -> m Type) -> m (Maybe Type) -> m Type
    forall a b. (a -> b) -> a -> b
    $ QName -> Type -> m (Maybe Type)
    forall (m :: * -> *). PureTCM m => QName -> Type -> m (Maybe Type)
    getDefType QName
    f Type
    targ

    -- | Syntax directed equality on atomic values
    --
    compareAtom :: forall m. MonadConversion m => Comparison -> CompareAs -> Term -> Term -> m ()
    compareAtom :: forall (m :: * -> *).
    MonadConversion m =>
    Comparison -> CompareAs -> Term -> Term -> m ()
    compareAtom Comparison
    cmp CompareAs
    t Term
    m Term
    n =
      VerboseKey -> Int -> VerboseKey -> m () -> m ()
    forall (m :: * -> *) a.
    MonadDebug m =>
    VerboseKey -> Int -> VerboseKey -> m a -> m a
    verboseBracket VerboseKey
    "tc.conv.atom" Int
    20 VerboseKey
    "compareAtom" (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $
      -- if a PatternErr is thrown, rebuild constraint!
      (Constraint -> m () -> m ()
    forall (m :: * -> *).
    MonadConstraint m =>
    Constraint -> m () -> m ()
    catchConstraint (Comparison -> CompareAs -> Term -> Term -> Constraint
    ValueCmp Comparison
    cmp CompareAs
    t Term
    m Term
    n) :: m () -> m ()) (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $ do
        VerboseKey -> Int -> VerboseKey -> m ()
    forall (m :: * -> *).
    MonadDebug m =>
    VerboseKey -> Int -> VerboseKey -> m ()
    reportSLn VerboseKey
    "tc.conv.atom.size" Int
    50 (VerboseKey -> m ()) -> VerboseKey -> m ()
    forall a b. (a -> b) -> a -> b
    $ VerboseKey
    "compareAtom term size:  " VerboseKey -> VerboseKey -> VerboseKey
    forall a. [a] -> [a] -> [a]
    ++ (Int, Int) -> VerboseKey
    forall a. Show a => a -> VerboseKey
    show (Term -> Int
    forall a. TermSize a => a -> Int
    termSize Term
    m, Term -> Int
    forall a. TermSize a => a -> Int
    termSize Term
    n)
        VerboseKey -> Int -> TCMT IO Doc -> m ()
    forall (m :: * -> *).
    MonadDebug m =>
    VerboseKey -> Int -> TCMT IO Doc -> m ()
    reportSDoc VerboseKey
    "tc.conv.atom" Int
    50 (TCMT IO Doc -> m ()) -> TCMT IO Doc -> m ()
    forall a b. (a -> b) -> a -> b
    $
          TCMT IO Doc
    "compareAtom" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> [TCMT IO Doc] -> TCMT IO Doc
    forall (m :: * -> *) (t :: * -> *).
    (Applicative m, Foldable t) =>
    t (m Doc) -> m Doc
    fsep [ Term -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM Term
    m TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> Comparison -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM Comparison
    cmp
                                 , Term -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM Term
    n
                                 , CompareAs -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM CompareAs
    t
                                 ]
        -- Andreas: what happens if I cut out the eta expansion here?
        -- Answer: Triggers issue 245, does not resolve 348
        (Blocked Term
    mb',Blocked Term
    nb') <- do
          Blocked Term
    mb' <- Blocked Term -> m (Blocked Term)
    forall (m :: * -> *) t.
    (MonadReduce m, MonadMetaSolver m, IsMeta t, Reduce t) =>
    Blocked t -> m (Blocked t)
    etaExpandBlocked (Blocked Term -> m (Blocked Term))
    -> m (Blocked Term) -> m (Blocked Term)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< Term -> m (Blocked Term)
    forall a (m :: * -> *).
    (Reduce a, MonadReduce m) =>
    a -> m (Blocked a)
    reduceB Term
    m
          Blocked Term
    nb' <- Blocked Term -> m (Blocked Term)
    forall (m :: * -> *) t.
    (MonadReduce m, MonadMetaSolver m, IsMeta t, Reduce t) =>
    Blocked t -> m (Blocked t)
    etaExpandBlocked (Blocked Term -> m (Blocked Term))
    -> m (Blocked Term) -> m (Blocked Term)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< Term -> m (Blocked Term)
    forall a (m :: * -> *).
    (Reduce a, MonadReduce m) =>
    a -> m (Blocked a)
    reduceB Term
    n
          (Blocked Term, Blocked Term) -> m (Blocked Term, Blocked Term)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Blocked Term
    mb', Blocked Term
    nb')
        let getBlocker :: Blocked' t a -> Blocker
    getBlocker (Blocked Blocker
    b a
    _) = Blocker
    b
            getBlocker NotBlocked{}  = Blocker
    neverUnblock
            blocker :: Blocker
    blocker = Blocker -> Blocker -> Blocker
    unblockOnEither (Blocked Term -> Blocker
    forall {t} {a}. Blocked' t a -> Blocker
    getBlocker Blocked Term
    mb') (Blocked Term -> Blocker
    forall {t} {a}. Blocked' t a -> Blocker
    getBlocker Blocked Term
    nb')
        VerboseKey -> Int -> VerboseKey -> m ()
    forall (m :: * -> *).
    MonadDebug m =>
    VerboseKey -> Int -> VerboseKey -> m ()
    reportSLn VerboseKey
    "tc.conv.atom.size" Int
    50 (VerboseKey -> m ()) -> VerboseKey -> m ()
    forall a b. (a -> b) -> a -> b
    $ VerboseKey
    "term size after reduce: " VerboseKey -> VerboseKey -> VerboseKey
    forall a. [a] -> [a] -> [a]
    ++ (Int, Int) -> VerboseKey
    forall a. Show a => a -> VerboseKey
    show (Term -> Int
    forall a. TermSize a => a -> Int
    termSize (Term -> Int) -> Term -> Int
    forall a b. (a -> b) -> a -> b
    $ Blocked Term -> Term
    forall t a. Blocked' t a -> a
    ignoreBlocking Blocked Term
    mb', Term -> Int
    forall a. TermSize a => a -> Int
    termSize (Term -> Int) -> Term -> Int
    forall a b. (a -> b) -> a -> b
    $ Blocked Term -> Term
    forall t a. Blocked' t a -> a
    ignoreBlocking Blocked Term
    nb')

        -- constructorForm changes literal to constructors
        -- only needed if the other side is not a literal
        (Blocked Term
    mb'', Blocked Term
    nb'') <- case (Blocked Term -> Term
    forall t a. Blocked' t a -> a
    ignoreBlocking Blocked Term
    mb', Blocked Term -> Term
    forall t a. Blocked' t a -> a
    ignoreBlocking Blocked Term
    nb') of
          (Lit Literal
    _, Lit Literal
    _) -> (Blocked Term, Blocked Term) -> m (Blocked Term, Blocked Term)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Blocked Term
    mb', Blocked Term
    nb')
          (Term, Term)
    _ -> (,) (Blocked Term -> Blocked Term -> (Blocked Term, Blocked Term))
    -> m (Blocked Term)
    -> m (Blocked Term -> (Blocked Term, Blocked Term))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Term -> m Term) -> Blocked Term -> m (Blocked Term)
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    traverse Term -> m Term
    forall (m :: * -> *). HasBuiltins m => Term -> m Term
    constructorForm Blocked Term
    mb'
                   m (Blocked Term -> (Blocked Term, Blocked Term))
    -> m (Blocked Term) -> m (Blocked Term, Blocked Term)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> (Term -> m Term) -> Blocked Term -> m (Blocked Term)
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    traverse Term -> m Term
    forall (m :: * -> *). HasBuiltins m => Term -> m Term
    constructorForm Blocked Term
    nb'

        Blocked Term
    mb <- (Term -> m Term) -> Blocked Term -> m (Blocked Term)
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    traverse Term -> m Term
    forall (m :: * -> *). HasBuiltins m => Term -> m Term
    unLevel Blocked Term
    mb''
        Blocked Term
    nb <- (Term -> m Term) -> Blocked Term -> m (Blocked Term)
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    traverse Term -> m Term
    forall (m :: * -> *). HasBuiltins m => Term -> m Term
    unLevel Blocked Term
    nb''

        Bool
    cmpBlocked <- Lens' Bool TCEnv -> m Bool
    forall (m :: * -> *) a. MonadTCEnv m => Lens' a TCEnv -> m a
    viewTC Lens' Bool TCEnv
    eCompareBlocked

        let m :: Term
    m = Blocked Term -> Term
    forall t a. Blocked' t a -> a
    ignoreBlocking Blocked Term
    mb
            n :: Term
    n = Blocked Term -> Term
    forall t a. Blocked' t a -> a
    ignoreBlocking Blocked Term
    nb

            checkDefinitionalEquality :: m ()
    checkDefinitionalEquality = m Bool -> m () -> m ()
    forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
    unlessM (Comparison -> CompareAs -> Term -> Term -> m Bool
    forall (m :: * -> *).
    (PureTCM m, MonadBlock m) =>
    Comparison -> CompareAs -> Term -> Term -> m Bool
    pureCompareAs Comparison
    CmpEq CompareAs
    t Term
    m Term
    n) m ()
    notEqual

            notEqual :: m ()
    notEqual = TypeError -> m ()
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCError m) =>
    TypeError -> m a
    typeError (TypeError -> m ()) -> TypeError -> m ()
    forall a b. (a -> b) -> a -> b
    $ Comparison -> Term -> Term -> CompareAs -> TypeError
    UnequalTerms Comparison
    cmp Term
    m Term
    n CompareAs
    t

            dir :: CompareDirection
    dir = Comparison -> CompareDirection
    fromCmp Comparison
    cmp
            rid :: CompareDirection
    rid = CompareDirection -> CompareDirection
    flipCmp CompareDirection
    dir     -- The reverse direction.  Bad name, I know.

            assign :: CompareDirection -> MetaId -> Elims -> Term -> m ()
    assign CompareDirection
    dir MetaId
    x Elims
    es Term
    v = CompareDirection
    -> MetaId
    -> Elims
    -> Term
    -> CompareAs
    -> (Term -> Term -> m ())
    -> m ()
    forall (m :: * -> *).
    MonadConversion m =>
    CompareDirection
    -> MetaId
    -> Elims
    -> Term
    -> CompareAs
    -> (Term -> Term -> m ())
    -> m ()
    assignE CompareDirection
    dir MetaId
    x Elims
    es Term
    v CompareAs
    t ((Term -> Term -> m ()) -> m ()) -> (Term -> Term -> m ()) -> m ()
    forall a b. (a -> b) -> a -> b
    $ CompareDirection -> CompareAs -> Term -> Term -> m ()
    forall (m :: * -> *).
    MonadConversion m =>
    CompareDirection -> CompareAs -> Term -> Term -> m ()
    compareAtomDir CompareDirection
    dir CompareAs
    t

        VerboseKey -> Int -> TCMT IO Doc -> m ()
    forall (m :: * -> *).
    MonadDebug m =>
    VerboseKey -> Int -> TCMT IO Doc -> m ()
    reportSDoc VerboseKey
    "tc.conv.atom" Int
    30 (TCMT IO Doc -> m ()) -> TCMT IO Doc -> m ()
    forall a b. (a -> b) -> a -> b
    $
          TCMT IO Doc
    "compareAtom" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> [TCMT IO Doc] -> TCMT IO Doc
    forall (m :: * -> *) (t :: * -> *).
    (Applicative m, Foldable t) =>
    t (m Doc) -> m Doc
    fsep [ Blocked Term -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM Blocked Term
    mb TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> Comparison -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM Comparison
    cmp
                                 , Blocked Term -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM Blocked Term
    nb
                                 , CompareAs -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM CompareAs
    t
                                 ]
        VerboseKey -> Int -> TCMT IO Doc -> m ()
    forall (m :: * -> *).
    MonadDebug m =>
    VerboseKey -> Int -> TCMT IO Doc -> m ()
    reportSDoc VerboseKey
    "tc.conv.atom" Int
    80 (TCMT IO Doc -> m ()) -> TCMT IO Doc -> m ()
    forall a b. (a -> b) -> a -> b
    $
          TCMT IO Doc
    "compareAtom" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> [TCMT IO Doc] -> TCMT IO Doc
    forall (m :: * -> *) (t :: * -> *).
    (Applicative m, Foldable t) =>
    t (m Doc) -> m Doc
    fsep [ (VerboseKey -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => VerboseKey -> m Doc
    text (VerboseKey -> TCMT IO Doc)
    -> (Blocked Term -> VerboseKey) -> Blocked Term -> TCMT IO Doc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Blocked Term -> VerboseKey
    forall a. Show a => a -> VerboseKey
    show) Blocked Term
    mb TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> Comparison -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM Comparison
    cmp
                                      , (VerboseKey -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => VerboseKey -> m Doc
    text (VerboseKey -> TCMT IO Doc)
    -> (Blocked Term -> VerboseKey) -> Blocked Term -> TCMT IO Doc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Blocked Term -> VerboseKey
    forall a. Show a => a -> VerboseKey
    show) Blocked Term
    nb
                                      , TCMT IO Doc
    ":" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> (VerboseKey -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => VerboseKey -> m Doc
    text (VerboseKey -> TCMT IO Doc)
    -> (CompareAs -> VerboseKey) -> CompareAs -> TCMT IO Doc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . CompareAs -> VerboseKey
    forall a. Show a => a -> VerboseKey
    show) CompareAs
    t ]
        case (Blocked Term
    mb, Blocked Term
    nb) of
          -- equate two metas x and y.  if y is the younger meta,
          -- try first y := x and then x := y
          (Blocked Term, Blocked Term)
    _ | MetaV MetaId
    x Elims
    xArgs <- Blocked Term -> Term
    forall t a. Blocked' t a -> a
    ignoreBlocking Blocked Term
    mb,   -- Can be either Blocked or NotBlocked depending on
              MetaV MetaId
    y Elims
    yArgs <- Blocked Term -> Term
    forall t a. Blocked' t a -> a
    ignoreBlocking Blocked Term
    nb -> -- envCompareBlocked check above.
            if | MetaId
    x MetaId -> MetaId -> Bool
    forall a. Eq a => a -> a -> Bool
    == MetaId
    y, Bool
    cmpBlocked -> do
                  Type
    a <- MetaId -> m Type
    forall (m :: * -> *).
    (MonadFail m, ReadTCState m) =>
    MetaId -> m Type
    metaType MetaId
    x
                  Blocker -> m () -> m ()
    forall (m :: * -> *) a. MonadError TCErr m => Blocker -> m a -> m a
    blockOnError (MetaId -> Blocker
    unblockOnMeta MetaId
    x) (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $
                    [Polarity] -> [IsForced] -> Type -> Term -> Elims -> Elims -> m ()
    forall (m :: * -> *).
    MonadConversion m =>
    [Polarity] -> [IsForced] -> Type -> Term -> Elims -> Elims -> m ()
    compareElims [] [] Type
    a (MetaId -> Elims -> Term
    MetaV MetaId
    x []) Elims
    xArgs Elims
    yArgs
               | MetaId
    x MetaId -> MetaId -> Bool
    forall a. Eq a => a -> a -> Bool
    == MetaId
    y -> Blocker -> m () -> m ()
    forall (m :: * -> *) a. MonadError TCErr m => Blocker -> m a -> m a
    blockOnError (MetaId -> Blocker
    unblockOnMeta MetaId
    x) (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $
                case Elims -> Elims -> Maybe [Bool]
    intersectVars Elims
    xArgs Elims
    yArgs of
                  -- all relevant arguments are variables
                  Just [Bool]
    kills -> do
                    -- kills is a list with 'True' for each different var
                    PruneResult
    killResult <- [Bool] -> MetaId -> m PruneResult
    forall (m :: * -> *).
    MonadMetaSolver m =>
    [Bool] -> MetaId -> m PruneResult
    killArgs [Bool]
    kills MetaId
    x
                    case PruneResult
    killResult of
                      PruneResult
    NothingToPrune   -> () -> m ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
                      PruneResult
    PrunedEverything -> () -> m ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
                      PruneResult
    PrunedNothing    -> m ()
    checkDefinitionalEquality
                      PruneResult
    PrunedSomething  -> m ()
    checkDefinitionalEquality
                  -- not all relevant arguments are variables
                  Maybe [Bool]
    Nothing -> m ()
    checkDefinitionalEquality -- Check definitional equality on meta-variables
                                  -- (same as for blocked terms)
               | Bool
    otherwise -> do
                  [MetaPriority
    p1, MetaPriority
    p2] <- (MetaId -> m MetaPriority) -> [MetaId] -> m [MetaPriority]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM MetaId -> m MetaPriority
    forall (m :: * -> *).
    (MonadFail m, ReadTCState m) =>
    MetaId -> m MetaPriority
    getMetaPriority [MetaId
    x,MetaId
    y]
                  -- First try the one with the highest priority. If that doesn't
                  -- work, try the low priority one.
                  let (m ()
    solve1, m ()
    solve2)
                        | (MetaPriority
    p1, MetaId
    x) (MetaPriority, MetaId) -> (MetaPriority, MetaId) -> Bool
    forall a. Ord a => a -> a -> Bool
    > (MetaPriority
    p2, MetaId
    y) = (m ()
    l1, m ()
    r2)
                        | Bool
    otherwise         = (m ()
    r1, m ()
    l2)
                        where l1 :: m ()
    l1 = CompareDirection -> MetaId -> Elims -> Term -> m ()
    assign CompareDirection
    dir MetaId
    x Elims
    xArgs Term
    n
                              r1 :: m ()
    r1 = CompareDirection -> MetaId -> Elims -> Term -> m ()
    assign CompareDirection
    rid MetaId
    y Elims
    yArgs Term
    m
                              -- Careful: the first attempt might prune the low
                              -- priority meta! (Issue #2978)
                              l2 :: m ()
    l2 = m Bool -> m () -> m () -> m ()
    forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
    ifM (MetaId -> m Bool
    forall a (m :: * -> *).
    (IsInstantiatedMeta a, MonadFail m, ReadTCState m) =>
    a -> m Bool
    isInstantiatedMeta MetaId
    x) (CompareDirection -> CompareAs -> Term -> Term -> m ()
    forall (m :: * -> *).
    MonadConversion m =>
    CompareDirection -> CompareAs -> Term -> Term -> m ()
    compareAsDir CompareDirection
    dir CompareAs
    t Term
    m Term
    n) m ()
    l1
                              r2 :: m ()
    r2 = m Bool -> m () -> m () -> m ()
    forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
    ifM (MetaId -> m Bool
    forall a (m :: * -> *).
    (IsInstantiatedMeta a, MonadFail m, ReadTCState m) =>
    a -> m Bool
    isInstantiatedMeta MetaId
    y) (CompareDirection -> CompareAs -> Term -> Term -> m ()
    forall (m :: * -> *).
    MonadConversion m =>
    CompareDirection -> CompareAs -> Term -> Term -> m ()
    compareAsDir CompareDirection
    rid CompareAs
    t Term
    n Term
    m) m ()
    r1

                  -- Unblock on both unblockers of solve1 and solve2
                  (Blocker -> m ()) -> m () -> m ()
    forall (m :: * -> *) a.
    MonadBlock m =>
    (Blocker -> m a) -> m a -> m a
    catchPatternErr (Blocker -> m () -> m ()
    forall (m :: * -> *) a. MonadBlock m => Blocker -> m a -> m a
    `addOrUnblocker` m ()
    solve2) m ()
    solve1

          -- one side a meta
          (Blocked Term, Blocked Term)
    _ | MetaV MetaId
    x Elims
    es <- Blocked Term -> Term
    forall t a. Blocked' t a -> a
    ignoreBlocking Blocked Term
    mb -> CompareDirection -> MetaId -> Elims -> Term -> m ()
    assign CompareDirection
    dir MetaId
    x Elims
    es Term
    n
          (Blocked Term, Blocked Term)
    _ | MetaV MetaId
    x Elims
    es <- Blocked Term -> Term
    forall t a. Blocked' t a -> a
    ignoreBlocking Blocked Term
    nb -> CompareDirection -> MetaId -> Elims -> Term -> m ()
    assign CompareDirection
    rid MetaId
    x Elims
    es Term
    m
          (Blocked{}, Blocked{}) | Bool -> Bool
    not Bool
    cmpBlocked  -> m ()
    checkDefinitionalEquality
          (Blocked Blocker
    b Term
    _, Blocked Term
    _) | Bool -> Bool
    not Bool
    cmpBlocked -> CompareDirection -> Blocker -> CompareAs -> Term -> Term -> m ()
    forall (m :: * -> *).
    MonadConversion m =>
    CompareDirection -> Blocker -> CompareAs -> Term -> Term -> m ()
    useInjectivity (Comparison -> CompareDirection
    fromCmp Comparison
    cmp) Blocker
    b CompareAs
    t Term
    m Term
    n   -- The blocked term  goes first
          (Blocked Term
    _, Blocked Blocker
    b Term
    _) | Bool -> Bool
    not Bool
    cmpBlocked -> CompareDirection -> Blocker -> CompareAs -> Term -> Term -> m ()
    forall (m :: * -> *).
    MonadConversion m =>
    CompareDirection -> Blocker -> CompareAs -> Term -> Term -> m ()
    useInjectivity (CompareDirection -> CompareDirection
    flipCmp (CompareDirection -> CompareDirection)
    -> CompareDirection -> CompareDirection
    forall a b. (a -> b) -> a -> b
    $ Comparison -> CompareDirection
    fromCmp Comparison
    cmp) Blocker
    b CompareAs
    t Term
    n Term
    m
          (Blocked Term, Blocked Term)
    _ -> Blocker -> m () -> m ()
    forall (m :: * -> *) a. MonadError TCErr m => Blocker -> m a -> m a
    blockOnError Blocker
    blocker (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $ do
            -- -- Andreas, 2013-10-20 put projection-like function
            -- -- into the spine, to make compareElims work.
            -- -- 'False' means: leave (Def f []) unchanged even for
            -- -- proj-like funs.
            -- m <- elimView False m
            -- n <- elimView False n
            -- Andreas, 2015-07-01, actually, don't put them into the spine.
            -- Polarity cannot be communicated properly if projection-like
            -- functions are post-fix.
            case (Term
    m, Term
    n) of
              (Pi{}, Pi{}) -> Term -> Term -> m ()
    equalFun Term
    m Term
    n

              (Sort Sort
    s1, Sort Sort
    s2) ->
                m Bool -> m () -> m () -> m ()
    forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
    ifM (PragmaOptions -> Bool
    optCumulativity (PragmaOptions -> Bool) -> m PragmaOptions -> m Bool
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> m PragmaOptions
    forall (m :: * -> *). HasOptions m => m PragmaOptions
    pragmaOptions)
                  (Comparison -> Sort -> Sort -> m ()
    forall (m :: * -> *).
    MonadConversion m =>
    Comparison -> Sort -> Sort -> m ()
    compareSort Comparison
    cmp Sort
    s1 Sort
    s2)
                  (Sort -> Sort -> m ()
    forall (m :: * -> *). MonadConversion m => Sort -> Sort -> m ()
    equalSort Sort
    s1 Sort
    s2)

              (Lit Literal
    l1, Lit Literal
    l2) | Literal
    l1 Literal -> Literal -> Bool
    forall a. Eq a => a -> a -> Bool
    == Literal
    l2 -> () -> m ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
              (Var Int
    i Elims
    es, Var Int
    i' Elims
    es') | Int
    i Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    i' -> do
                  Type
    a <- Int -> m Type
    forall (m :: * -> *).
    (Applicative m, MonadFail m, MonadTCEnv m) =>
    Int -> m Type
    typeOfBV Int
    i
                  -- Variables are invariant in their arguments
                  [Polarity] -> [IsForced] -> Type -> Term -> Elims -> Elims -> m ()
    forall (m :: * -> *).
    MonadConversion m =>
    [Polarity] -> [IsForced] -> Type -> Term -> Elims -> Elims -> m ()
    compareElims [] [] Type
    a (Int -> Term
    var Int
    i) Elims
    es Elims
    es'

              -- The case of definition application:
              (Def QName
    f Elims
    es, Def QName
    f' Elims
    es') -> do

                  -- 1. All absurd lambdas are equal.
                  m Bool -> m () -> m ()
    forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
    unlessM (QName -> QName -> m Bool
    forall (m :: * -> *). MonadConversion m => QName -> QName -> m Bool
    bothAbsurd QName
    f QName
    f') (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $ do

                  -- 2. If the heads are unequal, the only chance is subtyping between SIZE and SIZELT.
                  if QName
    f QName -> QName -> Bool
    forall a. Eq a => a -> a -> Bool
    /= QName
    f' then Comparison
    -> CompareAs
    -> Term
    -> Term
    -> QName
    -> Elims
    -> QName
    -> Elims
    -> m ()
    forall (m :: * -> *).
    MonadConversion m =>
    Comparison
    -> CompareAs
    -> Term
    -> Term
    -> QName
    -> Elims
    -> QName
    -> Elims
    -> m ()
    trySizeUniv Comparison
    cmp CompareAs
    t Term
    m Term
    n QName
    f Elims
    es QName
    f' Elims
    es' else do

                  -- 3. If the heads are equal:
                  -- 3a. If there are no arguments, we are done.
                  Bool -> m () -> m ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless (Elims -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null Elims
    es Bool -> Bool -> Bool
    && Elims -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null Elims
    es') (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $ do

                  -- 3b. If some cubical magic kicks in, we are done.
                  m Bool -> m () -> m ()
    forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
    unlessM (MonadConversion m => QName -> Elims -> Elims -> m Bool
    QName -> Elims -> Elims -> m Bool
    compareEtaPrims QName
    f Elims
    es Elims
    es') (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $ do

                  -- 3c. Oh no, we actually have to work and compare the eliminations!
                   Type
    a <- QName -> Elims -> Elims -> m Type
    forall (m :: * -> *).
    MonadConversion m =>
    QName -> Elims -> Elims -> m Type
    computeElimHeadType QName
    f Elims
    es Elims
    es'
                   -- The polarity vector of projection-like functions
                   -- does not include the parameters.
                   [Polarity]
    pol <- Comparison -> QName -> m [Polarity]
    forall (m :: * -> *).
    HasConstInfo m =>
    Comparison -> QName -> m [Polarity]
    getPolarity' Comparison
    cmp QName
    f
                   [Polarity] -> [IsForced] -> Type -> Term -> Elims -> Elims -> m ()
    forall (m :: * -> *).
    MonadConversion m =>
    [Polarity] -> [IsForced] -> Type -> Term -> Elims -> Elims -> m ()
    compareElims [Polarity]
    pol [] Type
    a (QName -> Elims -> Term
    Def QName
    f []) Elims
    es Elims
    es'

              -- Due to eta-expansion, these constructors are fully applied.
              (Con ConHead
    x ConInfo
    ci Elims
    xArgs, Con ConHead
    y ConInfo
    _ Elims
    yArgs)
                  | ConHead
    x ConHead -> ConHead -> Bool
    forall a. Eq a => a -> a -> Bool
    == ConHead
    y -> do
                      -- Get the type of the constructor instantiated to the datatype parameters.
                      Type
    a' <- case CompareAs
    t of
                        AsTermsOf Type
    a -> ConHead -> Type -> m Type
    forall {m :: * -> *}.
    (MonadBlock m, PureTCM m) =>
    ConHead -> Type -> m Type
    conType ConHead
    x Type
    a
                        CompareAs
    AsSizes   -> m Type
    forall a. HasCallStack => a
    __IMPOSSIBLE__
                        CompareAs
    AsTypes   -> m Type
    forall a. HasCallStack => a
    __IMPOSSIBLE__
                      [IsForced]
    forcedArgs <- QName -> m [IsForced]
    forall (m :: * -> *). HasConstInfo m => QName -> m [IsForced]
    getForcedArgs (QName -> m [IsForced]) -> QName -> m [IsForced]
    forall a b. (a -> b) -> a -> b
    $ ConHead -> QName
    conName ConHead
    x
                      -- Constructors are covariant in their arguments
                      -- (see test/succeed/CovariantConstructors).
                      [Polarity] -> [IsForced] -> Type -> Term -> Elims -> Elims -> m ()
    forall (m :: * -> *).
    MonadConversion m =>
    [Polarity] -> [IsForced] -> Type -> Term -> Elims -> Elims -> m ()
    compareElims (Polarity -> [Polarity]
    forall a. a -> [a]
    repeat (Polarity -> [Polarity]) -> Polarity -> [Polarity]
    forall a b. (a -> b) -> a -> b
    $ Comparison -> Polarity
    polFromCmp Comparison
    cmp) [IsForced]
    forcedArgs Type
    a' (ConHead -> ConInfo -> Elims -> Term
    Con ConHead
    x ConInfo
    ci []) Elims
    xArgs Elims
    yArgs
              (Term, Term)
    _ -> m ()
    notEqual
        where
            -- returns True in case we handled the comparison already.
            compareEtaPrims :: MonadConversion m => QName -> Elims -> Elims -> m Bool
            compareEtaPrims :: MonadConversion m => QName -> Elims -> Elims -> m Bool
    compareEtaPrims QName
    q Elims
    es Elims
    es' = do
              Maybe QName
    munglue <- VerboseKey -> m (Maybe QName)
    forall (m :: * -> *).
    HasBuiltins m =>
    VerboseKey -> m (Maybe QName)
    getPrimitiveName' VerboseKey
    builtin_unglue
              Maybe QName
    munglueU <- VerboseKey -> m (Maybe QName)
    forall (m :: * -> *).
    HasBuiltins m =>
    VerboseKey -> m (Maybe QName)
    getPrimitiveName' VerboseKey
    builtin_unglueU
              Maybe QName
    msubout <- VerboseKey -> m (Maybe QName)
    forall (m :: * -> *).
    HasBuiltins m =>
    VerboseKey -> m (Maybe QName)
    getPrimitiveName' VerboseKey
    builtinSubOut
              case () of
                ()
    _ | QName -> Maybe QName
    forall a. a -> Maybe a
    Just QName
    q Maybe QName -> Maybe QName -> Bool
    forall a. Eq a => a -> a -> Bool
    == Maybe QName
    munglue -> QName -> Elims -> Elims -> m Bool
    compareUnglueApp QName
    q Elims
    es Elims
    es'
                ()
    _ | QName -> Maybe QName
    forall a. a -> Maybe a
    Just QName
    q Maybe QName -> Maybe QName -> Bool
    forall a. Eq a => a -> a -> Bool
    == Maybe QName
    munglueU -> MonadConversion m => QName -> Elims -> Elims -> m Bool
    QName -> Elims -> Elims -> m Bool
    compareUnglueUApp QName
    q Elims
    es Elims
    es'
                ()
    _ | QName -> Maybe QName
    forall a. a -> Maybe a
    Just QName
    q Maybe QName -> Maybe QName -> Bool
    forall a. Eq a => a -> a -> Bool
    == Maybe QName
    msubout -> QName -> Elims -> Elims -> m Bool
    compareSubApp QName
    q Elims
    es Elims
    es'
                ()
    _                     -> Bool -> m Bool
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    False
            compareSubApp :: QName -> Elims -> Elims -> m Bool
    compareSubApp QName
    q Elims
    es Elims
    es' = do
              let (Elims
    as,Elims
    bs) = Int -> Elims -> (Elims, Elims)
    forall a. Int -> [a] -> ([a], [a])
    splitAt Int
    5 Elims
    es; (Elims
    as',Elims
    bs') = Int -> Elims -> (Elims, Elims)
    forall a. Int -> [a] -> ([a], [a])
    splitAt Int
    5 Elims
    es'
              case (Elims -> Maybe [Arg Term]
    forall a. [Elim' a] -> Maybe [Arg a]
    allApplyElims Elims
    as, Elims -> Maybe [Arg Term]
    forall a. [Elim' a] -> Maybe [Arg a]
    allApplyElims Elims
    as') of
                (Just [Arg Term
    a,Arg Term
    bA,Arg Term
    phi,Arg Term
    u,Arg Term
    x], Just [Arg Term
    a',Arg Term
    bA',Arg Term
    phi',Arg Term
    u',Arg Term
    x']) -> do
                  Term
    tSub <- m Term
    forall (m :: * -> *).
    (HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
    m Term
    primSub
                  -- Andrea, 28-07-16:
                  -- comparing the types is most probably wasteful,
                  -- since b and b' should be neutral terms, but it's a
                  -- precondition for the compareAtom call to make
                  -- sense.
                  Type -> Type -> m ()
    forall (m :: * -> *). MonadConversion m => Type -> Type -> m ()
    equalType (Sort -> Term -> Type
    forall t a. Sort' t -> a -> Type'' t a
    El (Term -> Sort
    tmSSort (Term -> Sort) -> Term -> Sort
    forall a b. (a -> b) -> a -> b
    $ Arg Term -> Term
    forall e. Arg e -> e
    unArg Arg Term
    a) (Term -> Type) -> Term -> Type
    forall a b. (a -> b) -> a -> b
    $ Term -> [Arg Term] -> Term
    forall t. Apply t => t -> [Arg Term] -> t
    apply Term
    tSub ([Arg Term] -> Term) -> [Arg Term] -> Term
    forall a b. (a -> b) -> a -> b
    $ Arg Term
    a Arg Term -> [Arg Term] -> [Arg Term]
    forall a. a -> [a] -> [a]
    : (Arg Term -> Arg Term) -> [Arg Term] -> [Arg Term]
    forall a b. (a -> b) -> [a] -> [b]
    map (Hiding -> Arg Term -> Arg Term
    forall a. LensHiding a => Hiding -> a -> a
    setHiding Hiding
    NotHidden) [Arg Term
    bA,Arg Term
    phi,Arg Term
    u])
                            (Sort -> Term -> Type
    forall t a. Sort' t -> a -> Type'' t a
    El (Term -> Sort
    tmSSort (Term -> Sort) -> Term -> Sort
    forall a b. (a -> b) -> a -> b
    $ Arg Term -> Term
    forall e. Arg e -> e
    unArg Arg Term
    a) (Term -> Type) -> Term -> Type
    forall a b. (a -> b) -> a -> b
    $ Term -> [Arg Term] -> Term
    forall t. Apply t => t -> [Arg Term] -> t
    apply Term
    tSub ([Arg Term] -> Term) -> [Arg Term] -> Term
    forall a b. (a -> b) -> a -> b
    $ Arg Term
    a Arg Term -> [Arg Term] -> [Arg Term]
    forall a. a -> [a] -> [a]
    : (Arg Term -> Arg Term) -> [Arg Term] -> [Arg Term]
    forall a b. (a -> b) -> [a] -> [b]
    map (Hiding -> Arg Term -> Arg Term
    forall a. LensHiding a => Hiding -> a -> a
    setHiding Hiding
    NotHidden) [Arg Term
    bA',Arg Term
    phi',Arg Term
    u'])
                  Comparison -> CompareAs -> Term -> Term -> m ()
    forall (m :: * -> *).
    MonadConversion m =>
    Comparison -> CompareAs -> Term -> Term -> m ()
    compareAtom Comparison
    cmp (Type -> CompareAs
    AsTermsOf (Type -> CompareAs) -> Type -> CompareAs
    forall a b. (a -> b) -> a -> b
    $ Sort -> Term -> Type
    forall t a. Sort' t -> a -> Type'' t a
    El (Term -> Sort
    tmSSort (Term -> Sort) -> Term -> Sort
    forall a b. (a -> b) -> a -> b
    $ Arg Term -> Term
    forall e. Arg e -> e
    unArg Arg Term
    a) (Term -> Type) -> Term -> Type
    forall a b. (a -> b) -> a -> b
    $ Term -> [Arg Term] -> Term
    forall t. Apply t => t -> [Arg Term] -> t
    apply Term
    tSub ([Arg Term] -> Term) -> [Arg Term] -> Term
    forall a b. (a -> b) -> a -> b
    $ Arg Term
    a Arg Term -> [Arg Term] -> [Arg Term]
    forall a. a -> [a] -> [a]
    : (Arg Term -> Arg Term) -> [Arg Term] -> [Arg Term]
    forall a b. (a -> b) -> [a] -> [b]
    map (Hiding -> Arg Term -> Arg Term
    forall a. LensHiding a => Hiding -> a -> a
    setHiding Hiding
    NotHidden) [Arg Term
    bA,Arg Term
    phi,Arg Term
    u])
                                  (Arg Term -> Term
    forall e. Arg e -> e
    unArg Arg Term
    x) (Arg Term -> Term
    forall e. Arg e -> e
    unArg Arg Term
    x')
                  [Polarity] -> [IsForced] -> Type -> Term -> Elims -> Elims -> m ()
    forall (m :: * -> *).
    MonadConversion m =>
    [Polarity] -> [IsForced] -> Type -> Term -> Elims -> Elims -> m ()
    compareElims [] [] (Sort -> Term -> Type
    forall t a. Sort' t -> a -> Type'' t a
    El (Term -> Sort
    tmSort (Arg Term -> Term
    forall e. Arg e -> e
    unArg Arg Term
    a)) (Arg Term -> Term
    forall e. Arg e -> e
    unArg Arg Term
    bA)) (QName -> Elims -> Term
    Def QName
    q Elims
    as) Elims
    bs Elims
    bs'
                  Bool -> m Bool
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    True
                (Maybe [Arg Term], Maybe [Arg Term])
    _  -> Bool -> m Bool
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    False
            compareUnglueApp :: QName -> Elims -> Elims -> m Bool
    compareUnglueApp QName
    q Elims
    es Elims
    es' = do
              let (Elims
    as,Elims
    bs) = Int -> Elims -> (Elims, Elims)
    forall a. Int -> [a] -> ([a], [a])
    splitAt Int
    7 Elims
    es; (Elims
    as',Elims
    bs') = Int -> Elims -> (Elims, Elims)
    forall a. Int -> [a] -> ([a], [a])
    splitAt Int
    7 Elims
    es'
              case (Elims -> Maybe [Arg Term]
    forall a. [Elim' a] -> Maybe [Arg a]
    allApplyElims Elims
    as, Elims -> Maybe [Arg Term]
    forall a. [Elim' a] -> Maybe [Arg a]
    allApplyElims Elims
    as') of
                (Just [Arg Term
    la,Arg Term
    lb,Arg Term
    bA,Arg Term
    phi,Arg Term
    bT,Arg Term
    e,Arg Term
    b], Just [Arg Term
    la',Arg Term
    lb',Arg Term
    bA',Arg Term
    phi',Arg Term
    bT',Arg Term
    e',Arg Term
    b']) -> do
                  Term
    tGlue <- VerboseKey -> m Term
    forall (m :: * -> *).
    (HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
    VerboseKey -> m Term
    getPrimitiveTerm VerboseKey
    builtinGlue
                  -- Andrea, 28-07-16:
                  -- comparing the types is most probably wasteful,
                  -- since b and b' should be neutral terms, but it's a
                  -- precondition for the compareAtom call to make
                  -- sense.
                  -- equalType (El (tmSort (unArg lb)) $ apply tGlue $ [la,lb] ++ map (setHiding NotHidden) [bA,phi,bT,e])
                  --           (El (tmSort (unArg lb')) $ apply tGlue $ [la',lb'] ++ map (setHiding NotHidden) [bA',phi',bT',e'])
                  Comparison -> CompareAs -> Term -> Term -> m ()
    forall (m :: * -> *).
    MonadConversion m =>
    Comparison -> CompareAs -> Term -> Term -> m ()
    compareAtom Comparison
    cmp (Type -> CompareAs
    AsTermsOf (Type -> CompareAs) -> Type -> CompareAs
    forall a b. (a -> b) -> a -> b
    $ Sort -> Term -> Type
    forall t a. Sort' t -> a -> Type'' t a
    El (Term -> Sort
    tmSort (Arg Term -> Term
    forall e. Arg e -> e
    unArg Arg Term
    lb)) (Term -> Type) -> Term -> Type
    forall a b. (a -> b) -> a -> b
    $ Term -> [Arg Term] -> Term
    forall t. Apply t => t -> [Arg Term] -> t
    apply Term
    tGlue ([Arg Term] -> Term) -> [Arg Term] -> Term
    forall a b. (a -> b) -> a -> b
    $ [Arg Term
    la,Arg Term
    lb] [Arg Term] -> [Arg Term] -> [Arg Term]
    forall a. [a] -> [a] -> [a]
    ++ (Arg Term -> Arg Term) -> [Arg Term] -> [Arg Term]
    forall a b. (a -> b) -> [a] -> [b]
    map (Hiding -> Arg Term -> Arg Term
    forall a. LensHiding a => Hiding -> a -> a
    setHiding Hiding
    NotHidden) [Arg Term
    bA,Arg Term
    phi,Arg Term
    bT,Arg Term
    e])
                                  (Arg Term -> Term
    forall e. Arg e -> e
    unArg Arg Term
    b) (Arg Term -> Term
    forall e. Arg e -> e
    unArg Arg Term
    b')
                  [Polarity] -> [IsForced] -> Type -> Term -> Elims -> Elims -> m ()
    forall (m :: * -> *).
    MonadConversion m =>
    [Polarity] -> [IsForced] -> Type -> Term -> Elims -> Elims -> m ()
    compareElims [] [] (Sort -> Term -> Type
    forall t a. Sort' t -> a -> Type'' t a
    El (Term -> Sort
    tmSort (Arg Term -> Term
    forall e. Arg e -> e
    unArg Arg Term
    la)) (Arg Term -> Term
    forall e. Arg e -> e
    unArg Arg Term
    bA)) (QName -> Elims -> Term
    Def QName
    q Elims
    as) Elims
    bs Elims
    bs'
                  Bool -> m Bool
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    True
                (Maybe [Arg Term], Maybe [Arg Term])
    _  -> Bool -> m Bool
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    False
            compareUnglueUApp :: MonadConversion m => QName -> Elims -> Elims -> m Bool
            compareUnglueUApp :: MonadConversion m => QName -> Elims -> Elims -> m Bool
    compareUnglueUApp QName
    q Elims
    es Elims
    es' = do
              let (Elims
    as,Elims
    bs) = Int -> Elims -> (Elims, Elims)
    forall a. Int -> [a] -> ([a], [a])
    splitAt Int
    5 Elims
    es; (Elims
    as',Elims
    bs') = Int -> Elims -> (Elims, Elims)
    forall a. Int -> [a] -> ([a], [a])
    splitAt Int
    5 Elims
    es'
              case (Elims -> Maybe [Arg Term]
    forall a. [Elim' a] -> Maybe [Arg a]
    allApplyElims Elims
    as, Elims -> Maybe [Arg Term]
    forall a. [Elim' a] -> Maybe [Arg a]
    allApplyElims Elims
    as') of
                (Just [Arg Term
    la,Arg Term
    phi,Arg Term
    bT,Arg Term
    bAS,Arg Term
    b], Just [Arg Term
    la',Arg Term
    phi',Arg Term
    bT',Arg Term
    bA',Arg Term
    b']) -> do
                  Term
    tHComp <- m Term
    forall (m :: * -> *).
    (HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
    m Term
    primHComp
                  Term
    tLSuc <- m Term
    forall (m :: * -> *).
    (HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
    m Term
    primLevelSuc
                  Term
    tSubOut <- m Term
    forall (m :: * -> *).
    (HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
    m Term
    primSubOut
                  Term
    iz <- m Term
    forall (m :: * -> *).
    (HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
    m Term
    primIZero
                  let lsuc :: Term -> Term
    lsuc Term
    t = Term
    tLSuc Term -> [Arg Term] -> Term
    forall t. Apply t => t -> [Arg Term] -> t
    `apply` [Term -> Arg Term
    forall e. e -> Arg e
    argN Term
    t]
                      s :: Sort
    s = Term -> Sort
    tmSort (Term -> Sort) -> Term -> Sort
    forall a b. (a -> b) -> a -> b
    $ Arg Term -> Term
    forall e. Arg e -> e
    unArg Arg Term
    la
                      sucla :: Arg Term
    sucla = Term -> Term
    lsuc (Term -> Term) -> Arg Term -> Arg Term
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Arg Term
    la
                  Term
    bA <- Names -> NamesT m Term -> m Term
    forall (m :: * -> *) a. Names -> NamesT m a -> m a
    runNamesT [] (NamesT m Term -> m Term) -> NamesT m Term -> m Term
    forall a b. (a -> b) -> a -> b
    $ do
                    [NamesT m Term
    la,NamesT m Term
    phi,NamesT m Term
    bT,NamesT m Term
    bAS] <- (Arg Term -> NamesT m (NamesT m Term))
    -> [Arg Term] -> NamesT m [NamesT m Term]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM (Term -> NamesT m (NamesT m Term)
    forall (m :: * -> *) a.
    (MonadFail m, Subst a) =>
    a -> NamesT m (NamesT m a)
    open (Term -> NamesT m (NamesT m Term))
    -> (Arg Term -> Term) -> Arg Term -> NamesT m (NamesT m 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
    bAS]
                    (Term -> NamesT m Term
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Term
    tSubOut NamesT m Term -> NamesT m Term -> NamesT m Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <#> (Term -> NamesT m Term
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Term
    tLSuc NamesT m Term -> NamesT m Term -> NamesT m Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <@> NamesT m Term
    la) NamesT m Term -> NamesT m Term -> NamesT m Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <#> (Sort -> Term
    Sort (Sort -> Term) -> (Term -> Sort) -> Term -> Term
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Term -> Sort
    tmSort (Term -> Term) -> NamesT m Term -> NamesT m Term
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> NamesT m Term
    la) NamesT m Term -> NamesT m Term -> NamesT m Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <#> NamesT m Term
    phi NamesT m Term -> NamesT m Term -> NamesT m Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <#> (NamesT m Term
    bT NamesT m Term -> NamesT m Term -> NamesT m Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <@> NamesT m Term
    forall (m :: * -> *).
    (HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
    m Term
    primIZero) NamesT m Term -> NamesT m Term -> NamesT m Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <@> NamesT m Term
    bAS)
                  Comparison -> CompareAs -> Term -> Term -> m ()
    forall (m :: * -> *).
    MonadConversion m =>
    Comparison -> CompareAs -> Term -> Term -> m ()
    compareAtom Comparison
    cmp (Type -> CompareAs
    AsTermsOf (Type -> CompareAs) -> Type -> CompareAs
    forall a b. (a -> b) -> a -> b
    $ Sort -> Term -> Type
    forall t a. Sort' t -> a -> Type'' t a
    El (Term -> Sort
    tmSort (Term -> Sort) -> (Arg Term -> Term) -> Arg Term -> Sort
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Arg Term -> Term
    forall e. Arg e -> e
    unArg (Arg Term -> Sort) -> Arg Term -> Sort
    forall a b. (a -> b) -> a -> b
    $ Arg Term
    sucla) (Term -> Type) -> Term -> Type
    forall a b. (a -> b) -> a -> b
    $ Term -> [Arg Term] -> Term
    forall t. Apply t => t -> [Arg Term] -> t
    apply Term
    tHComp ([Arg Term] -> Term) -> [Arg Term] -> Term
    forall a b. (a -> b) -> a -> b
    $ [Arg Term
    sucla, Term -> Arg Term
    forall e. e -> Arg e
    argH (Sort -> Term
    Sort Sort
    s), Arg Term
    phi] [Arg Term] -> [Arg Term] -> [Arg Term]
    forall a. [a] -> [a] -> [a]
    ++ [Term -> Arg Term
    forall e. e -> Arg e
    argH (Arg Term -> Term
    forall e. Arg e -> e
    unArg Arg Term
    bT), Term -> Arg Term
    forall e. e -> Arg e
    argH Term
    bA])
                                  (Arg Term -> Term
    forall e. Arg e -> e
    unArg Arg Term
    b) (Arg Term -> Term
    forall e. Arg e -> e
    unArg Arg Term
    b')
                  [Polarity] -> [IsForced] -> Type -> Term -> Elims -> Elims -> m ()
    forall (m :: * -> *).
    MonadConversion m =>
    [Polarity] -> [IsForced] -> Type -> Term -> Elims -> Elims -> m ()
    compareElims [] [] (Sort -> Term -> Type
    forall t a. Sort' t -> a -> Type'' t a
    El Sort
    s Term
    bA) (QName -> Elims -> Term
    Def QName
    q Elims
    as) Elims
    bs Elims
    bs'
                  Bool -> m Bool
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    True
                (Maybe [Arg Term], Maybe [Arg Term])
    _  -> Bool -> m Bool
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    False
            -- Andreas, 2013-05-15 due to new postponement strategy, type can now be blocked
            conType :: ConHead -> Type -> m Type
    conType ConHead
    c Type
    t = do
              Type
    t <- Type -> m Type
    forall (m :: * -> *) t.
    (MonadReduce m, MonadBlock m, IsMeta t, Reduce t) =>
    t -> m t
    abortIfBlocked Type
    t
              let impossible :: m Type
    impossible = do
                    VerboseKey -> Int -> TCMT IO Doc -> m ()
    forall (m :: * -> *).
    MonadDebug m =>
    VerboseKey -> Int -> TCMT IO Doc -> m ()
    reportSDoc VerboseKey
    "impossible" Int
    10 (TCMT IO Doc -> m ()) -> TCMT IO Doc -> m ()
    forall a b. (a -> b) -> a -> b
    $
                      TCMT IO Doc
    "expected data/record type, found " TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> Type -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM Type
    t
                    VerboseKey -> Int -> TCMT IO Doc -> m ()
    forall (m :: * -> *).
    MonadDebug m =>
    VerboseKey -> Int -> TCMT IO Doc -> m ()
    reportSDoc VerboseKey
    "impossible" Int
    70 (TCMT IO Doc -> m ()) -> TCMT IO Doc -> m ()
    forall a b. (a -> b) -> a -> b
    $ Int -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Functor m => Int -> m Doc -> m Doc
    nest Int
    2 (TCMT IO Doc -> TCMT IO Doc) -> TCMT IO Doc -> TCMT IO Doc
    forall a b. (a -> b) -> a -> b
    $ TCMT IO Doc
    "raw =" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> Type -> TCMT IO Doc
    forall (m :: * -> *) a. (Applicative m, Pretty a) => a -> m Doc
    pretty Type
    t
                    -- __IMPOSSIBLE__
                    -- Andreas, 2013-10-20:  in case termination checking fails
                    -- we might get some unreduced types here.
                    -- In issue 921, this happens during the final attempt
                    -- to solve left-over constraints.
                    -- Thus, instead of crashing, just give up gracefully.
                    Blocker -> m Type
    forall (m :: * -> *) a. MonadBlock m => Blocker -> m a
    patternViolation Blocker
    neverUnblock
              m Type
    -> (((QName, Type, [Arg Term]), Type) -> m Type)
    -> Maybe ((QName, Type, [Arg Term]), Type)
    -> m Type
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe m Type
    impossible (Type -> m Type
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Type -> m Type)
    -> (((QName, Type, [Arg Term]), Type) -> Type)
    -> ((QName, Type, [Arg Term]), Type)
    -> m Type
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((QName, Type, [Arg Term]), Type) -> Type
    forall a b. (a, b) -> b
    snd) (Maybe ((QName, Type, [Arg Term]), Type) -> m Type)
    -> m (Maybe ((QName, Type, [Arg Term]), Type)) -> m Type
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< ConHead -> Type -> m (Maybe ((QName, Type, [Arg Term]), Type))
    forall (m :: * -> *).
    PureTCM m =>
    ConHead -> Type -> m (Maybe ((QName, Type, [Arg Term]), Type))
    getFullyAppliedConType ConHead
    c Type
    t
            equalFun :: Term -> Term -> m ()
    equalFun Term
    t1 Term
    t2 = case (Term
    t1, Term
    t2) of
              (Pi Dom Type
    dom1 Abs Type
    b1, Pi Dom Type
    dom2 Abs Type
    b2) -> do
                VerboseKey -> Int -> VerboseKey -> m () -> m ()
    forall (m :: * -> *) a.
    MonadDebug m =>
    VerboseKey -> Int -> VerboseKey -> m a -> m a
    verboseBracket VerboseKey
    "tc.conv.fun" Int
    15 VerboseKey
    "compare function types" (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $ do
                  VerboseKey -> Int -> TCMT IO Doc -> m ()
    forall (m :: * -> *).
    MonadDebug m =>
    VerboseKey -> Int -> TCMT IO Doc -> m ()
    reportSDoc VerboseKey
    "tc.conv.fun" Int
    20 (TCMT IO Doc -> m ()) -> TCMT IO Doc -> m ()
    forall a b. (a -> b) -> a -> b
    $ Int -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Functor m => Int -> m Doc -> m Doc
    nest Int
    2 (TCMT IO Doc -> TCMT IO Doc) -> TCMT IO Doc -> TCMT IO Doc
    forall a b. (a -> b) -> a -> b
    $ [TCMT IO Doc] -> TCMT IO Doc
    forall (m :: * -> *) (t :: * -> *).
    (Applicative m, Foldable t) =>
    t (m Doc) -> m Doc
    vcat
                    [ TCMT IO Doc
    "t1 =" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> Term -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM Term
    t1
                    , TCMT IO Doc
    "t2 =" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> Term -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM Term
    t2
                    ]
                  Comparison
    -> Dom Type
    -> Dom Type
    -> Abs Type
    -> Abs Type
    -> m ()
    -> m ()
    -> m ()
    -> m ()
    -> m ()
    -> m ()
    forall (m :: * -> *) c b.
    (MonadConversion m, Free c) =>
    Comparison
    -> Dom Type
    -> Dom Type
    -> Abs b
    -> Abs c
    -> m ()
    -> m ()
    -> m ()
    -> m ()
    -> m ()
    -> m ()
    compareDom Comparison
    cmp Dom Type
    dom2 Dom Type
    dom1 Abs Type
    b1 Abs Type
    b2 m ()
    errH m ()
    errR m ()
    errQ m ()
    errC (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $
                    Comparison -> Type -> Type -> m ()
    forall (m :: * -> *).
    MonadConversion m =>
    Comparison -> Type -> Type -> m ()
    compareType Comparison
    cmp (Abs Type -> Type
    forall a. Subst a => Abs a -> a
    absBody Abs Type
    b1) (Abs Type -> Type
    forall a. Subst a => Abs a -> a
    absBody Abs Type
    b2)
                where
                errH :: m ()
    errH = TypeError -> m ()
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCError m) =>
    TypeError -> m a
    typeError (TypeError -> m ()) -> TypeError -> m ()
    forall a b. (a -> b) -> a -> b
    $ Term -> Term -> TypeError
    UnequalHiding Term
    t1 Term
    t2
                errR :: m ()
    errR = TypeError -> m ()
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCError m) =>
    TypeError -> m a
    typeError (TypeError -> m ()) -> TypeError -> m ()
    forall a b. (a -> b) -> a -> b
    $ Comparison -> Term -> Term -> TypeError
    UnequalRelevance Comparison
    cmp Term
    t1 Term
    t2
                errQ :: m ()
    errQ = TypeError -> m ()
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCError m) =>
    TypeError -> m a
    typeError (TypeError -> m ()) -> TypeError -> m ()
    forall a b. (a -> b) -> a -> b
    $ Comparison -> Term -> Term -> TypeError
    UnequalQuantity  Comparison
    cmp Term
    t1 Term
    t2
                errC :: m ()
    errC = TypeError -> m ()
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCError m) =>
    TypeError -> m a
    typeError (TypeError -> m ()) -> TypeError -> m ()
    forall a b. (a -> b) -> a -> b
    $ Comparison -> Term -> Term -> TypeError
    UnequalCohesion Comparison
    cmp Term
    t1 Term
    t2
              (Term, Term)
    _ -> m ()
    forall a. HasCallStack => a
    __IMPOSSIBLE__

    -- | Check whether @a1 `cmp` a2@ and continue in context extended by @a1@.
    compareDom :: (MonadConversion m , Free c)
      => Comparison -- ^ @cmp@ The comparison direction
      -> Dom Type   -- ^ @a1@  The smaller domain.
      -> Dom Type   -- ^ @a2@  The other domain.
      -> Abs b      -- ^ @b1@  The smaller codomain.
      -> Abs c      -- ^ @b2@  The bigger codomain.
      -> m ()     -- ^ Continuation if mismatch in 'Hiding'.
      -> m ()     -- ^ Continuation if mismatch in 'Relevance'.
      -> m ()     -- ^ Continuation if mismatch in 'Quantity'.
      -> m ()     -- ^ Continuation if mismatch in 'Cohesion'.
      -> m ()     -- ^ Continuation if comparison is successful.
      -> m ()
    compareDom :: forall (m :: * -> *) c b.
    (MonadConversion m, Free c) =>
    Comparison
    -> Dom Type
    -> Dom Type
    -> Abs b
    -> Abs c
    -> m ()
    -> m ()
    -> m ()
    -> m ()
    -> m ()
    -> m ()
    compareDom Comparison
    cmp0
      dom1 :: Dom Type
    dom1@(Dom{domInfo :: forall t e. Dom' t e -> ArgInfo
    domInfo = ArgInfo
    i1, unDom :: forall t e. Dom' t e -> e
    unDom = Type
    a1})
      dom2 :: Dom Type
    dom2@(Dom{domInfo :: forall t e. Dom' t e -> ArgInfo
    domInfo = ArgInfo
    i2, unDom :: forall t e. Dom' t e -> e
    unDom = Type
    a2})
      Abs b
    b1 Abs c
    b2 m ()
    errH m ()
    errR m ()
    errQ m ()
    errC m ()
    cont = do
      Bool
    hasSubtyping <- WithDefault 'False -> Bool
    forall (b :: Bool). KnownBool b => WithDefault b -> Bool
    collapseDefault (WithDefault 'False -> Bool)
    -> (PragmaOptions -> WithDefault 'False) -> PragmaOptions -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . PragmaOptions -> WithDefault 'False
    optSubtyping (PragmaOptions -> Bool) -> m PragmaOptions -> m Bool
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> m PragmaOptions
    forall (m :: * -> *). HasOptions m => m PragmaOptions
    pragmaOptions
      let cmp :: Comparison
    cmp = if Bool
    hasSubtyping then Comparison
    cmp0 else Comparison
    CmpEq
      if | Bool -> Bool
    not (Bool -> Bool) -> Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $ Dom Type -> Dom Type -> Bool
    forall a b. (LensHiding a, LensHiding b) => a -> b -> Bool
    sameHiding Dom Type
    dom1 Dom Type
    dom2 -> m ()
    errH
         | Bool -> Bool
    not (Bool -> Bool) -> Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $ Comparison -> Relevance -> Relevance -> Bool
    compareRelevance Comparison
    cmp (Dom Type -> Relevance
    forall a. LensRelevance a => a -> Relevance
    getRelevance Dom Type
    dom1) (Dom Type -> Relevance
    forall a. LensRelevance a => a -> Relevance
    getRelevance Dom Type
    dom2) -> m ()
    errR
         | Bool -> Bool
    not (Bool -> Bool) -> Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $ Comparison -> Quantity -> Quantity -> Bool
    compareQuantity  Comparison
    cmp (Dom Type -> Quantity
    forall a. LensQuantity a => a -> Quantity
    getQuantity  Dom Type
    dom1) (Dom Type -> Quantity
    forall a. LensQuantity a => a -> Quantity
    getQuantity  Dom Type
    dom2) -> m ()
    errQ
         | Bool -> Bool
    not (Bool -> Bool) -> Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $ Comparison -> Cohesion -> Cohesion -> Bool
    compareCohesion  Comparison
    cmp (Dom Type -> Cohesion
    forall a. LensCohesion a => a -> Cohesion
    getCohesion  Dom Type
    dom1) (Dom Type -> Cohesion
    forall a. LensCohesion a => a -> Cohesion
    getCohesion  Dom Type
    dom2) -> m ()
    errC
         | Bool
    otherwise -> do
          let r :: Relevance
    r = Relevance -> Relevance -> Relevance
    forall a. Ord a => a -> a -> a
    max (Dom Type -> Relevance
    forall a. LensRelevance a => a -> Relevance
    getRelevance Dom Type
    dom1) (Dom Type -> Relevance
    forall a. LensRelevance a => a -> Relevance
    getRelevance Dom Type
    dom2)
                  -- take "most irrelevant"
              dependent :: Bool
    dependent = (Relevance
    r Relevance -> Relevance -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Relevance
    Irrelevant) Bool -> Bool -> Bool
    && Abs c -> Bool
    forall a. Free a => Abs a -> Bool
    isBinderUsed Abs c
    b2
          ProblemId
    pid <- m () -> m ProblemId
    forall (m :: * -> *) a.
    (MonadFresh ProblemId m, MonadConstraint m) =>
    m a -> m ProblemId
    newProblem_ (m () -> m ProblemId) -> m () -> m ProblemId
    forall a b. (a -> b) -> a -> b
    $ Comparison -> Type -> Type -> m ()
    forall (m :: * -> *).
    MonadConversion m =>
    Comparison -> Type -> Type -> m ()
    compareType Comparison
    cmp0 Type
    a1 Type
    a2
          Dom Type
    dom <- if Bool
    dependent
                 then (\ Type
    a -> Dom Type
    dom1 {unDom :: Type
    unDom = Type
    a}) (Type -> Dom Type) -> m Type -> m (Dom Type)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Type -> ProblemId -> m Type
    forall (m :: * -> *).
    (MonadMetaSolver m, MonadFresh Int m) =>
    Type -> ProblemId -> m Type
    blockTypeOnProblem Type
    a1 ProblemId
    pid
                 else Dom Type -> m (Dom Type)
    forall (m :: * -> *) a. Monad m => a -> m a
    return Dom Type
    dom1
            -- We only need to require a1 == a2 if b2 is dependent
            -- If it's non-dependent it doesn't matter what we add to the context.
          let name :: VerboseKey
    name = [Suggestion] -> VerboseKey
    suggests [ Abs b -> Suggestion
    forall a. Suggest a => a -> Suggestion
    Suggestion Abs b
    b1 , Abs c -> Suggestion
    forall a. Suggest a => a -> Suggestion
    Suggestion Abs c
    b2 ]
          (VerboseKey, Dom Type) -> m () -> m ()
    forall b (m :: * -> *) a.
    (AddContext b, MonadAddContext m) =>
    b -> m a -> m a
    addContext (VerboseKey
    name, Dom Type
    dom) (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $ m ()
    cont
          ProblemId -> m ()
    forall (m :: * -> *). MonadConstraint m => ProblemId -> m ()
    stealConstraints ProblemId
    pid
            -- Andreas, 2013-05-15 Now, comparison of codomains is not
            -- blocked any more by getting stuck on domains.
            -- Only the domain type in context will be blocked.
            -- But see issue #1258.

    compareRelevance :: Comparison -> Relevance -> Relevance -> Bool
    compareRelevance :: Comparison -> Relevance -> Relevance -> Bool
    compareRelevance Comparison
    CmpEq  = Relevance -> Relevance -> Bool
    forall a. Eq a => a -> a -> Bool
    (==)
    compareRelevance Comparison
    CmpLeq = Relevance -> Relevance -> Bool
    forall a. Ord a => a -> a -> Bool
    (<=)

    compareQuantity :: Comparison -> Quantity -> Quantity -> Bool
    compareQuantity :: Comparison -> Quantity -> Quantity -> Bool
    compareQuantity Comparison
    CmpEq  = Quantity -> Quantity -> Bool
    sameQuantity
    compareQuantity Comparison
    CmpLeq = Quantity -> Quantity -> Bool
    moreQuantity

    compareCohesion :: Comparison -> Cohesion -> Cohesion -> Bool
    compareCohesion :: Comparison -> Cohesion -> Cohesion -> Bool
    compareCohesion Comparison
    CmpEq  = Cohesion -> Cohesion -> Bool
    sameCohesion
    compareCohesion Comparison
    CmpLeq = Cohesion -> Cohesion -> Bool
    moreCohesion

    -- | When comparing argument spines (in compareElims) where the first arguments
    --   don't match, we keep going, substituting the anti-unification of the two
    --   terms in the telescope. More precisely:
    --
    --  @@
    --    (u = v : A)[pid]   w = antiUnify pid A u v   us = vs : Δ[w/x]
    --    -------------------------------------------------------------
    --                    u us = v vs : (x : A) Δ
    --  @@
    --
    --   The simplest case of anti-unification is to return a fresh metavariable
    --   (created by blockTermOnProblem), but if there's shared structure between
    --   the two terms we can expose that.
    --
    --   This is really a crutch that lets us get away with things that otherwise
    --   would require heterogenous conversion checking. See for instance issue
    --   #2384.
    antiUnify :: MonadConversion m => ProblemId -> Type -> Term -> Term -> m Term
    antiUnify :: forall (m :: * -> *).
    MonadConversion m =>
    ProblemId -> Type -> Term -> Term -> m Term
    antiUnify ProblemId
    pid Type
    a Term
    u Term
    v = do
      ((Term
    u, Term
    v), Bool
    eq) <- Term -> Term -> m ((Term, Term), Bool)
    forall a (m :: * -> *).
    (Instantiate a, SynEq a, MonadReduce m) =>
    a -> a -> m ((a, a), Bool)
    SynEq.checkSyntacticEquality Term
    u Term
    v
      if Bool
    eq then Term -> m Term
    forall (m :: * -> *) a. Monad m => a -> m a
    return Term
    u else do
      (Term
    u, Term
    v) <- (Term, Term) -> m (Term, Term)
    forall a (m :: * -> *). (Reduce a, MonadReduce m) => a -> m a
    reduce (Term
    u, Term
    v)
      VerboseKey -> Int -> TCMT IO Doc -> m ()
    forall (m :: * -> *).
    MonadDebug m =>
    VerboseKey -> Int -> TCMT IO Doc -> m ()
    reportSDoc VerboseKey
    "tc.conv.antiUnify" Int
    30 (TCMT IO Doc -> m ()) -> TCMT IO Doc -> m ()
    forall a b. (a -> b) -> a -> b
    $ [TCMT IO Doc] -> TCMT IO Doc
    forall (m :: * -> *) (t :: * -> *).
    (Applicative m, Foldable t) =>
    t (m Doc) -> m Doc
    vcat
        [ TCMT IO Doc
    "antiUnify"
        , TCMT IO Doc
    "a =" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> Type -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM Type
    a
        , TCMT IO Doc
    "u =" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> Term -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM Term
    u
        , TCMT IO Doc
    "v =" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> Term -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM Term
    v
        ]
      case (Term
    u, Term
    v) of
        (Pi Dom Type
    ua Abs Type
    ub, Pi Dom Type
    va Abs Type
    vb) -> do
          Type
    wa0 <- ProblemId -> Type -> Type -> m Type
    forall (m :: * -> *).
    MonadConversion m =>
    ProblemId -> Type -> Type -> m Type
    antiUnifyType ProblemId
    pid (Dom Type -> Type
    forall t e. Dom' t e -> e
    unDom Dom Type
    ua) (Dom Type -> Type
    forall t e. Dom' t e -> e
    unDom Dom Type
    va)
          let wa :: Dom Type
    wa = Type
    wa0 Type -> Dom Type -> Dom Type
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ Dom Type
    ua
          Type
    wb <- Dom Type -> m Type -> m Type
    forall b (m :: * -> *) a.
    (AddContext b, MonadAddContext m) =>
    b -> m a -> m a
    addContext Dom Type
    wa (m Type -> m Type) -> m Type -> m Type
    forall a b. (a -> b) -> a -> b
    $ ProblemId -> Type -> Type -> m Type
    forall (m :: * -> *).
    MonadConversion m =>
    ProblemId -> Type -> Type -> m Type
    antiUnifyType ProblemId
    pid (Abs Type -> Type
    forall a. Subst a => Abs a -> a
    absBody Abs Type
    ub) (Abs Type -> Type
    forall a. Subst a => Abs a -> a
    absBody Abs Type
    vb)
          Term -> m Term
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Term -> m Term) -> Term -> m Term
    forall a b. (a -> b) -> a -> b
    $ Dom Type -> Abs Type -> Term
    Pi Dom Type
    wa (VerboseKey -> Type -> Abs Type
    forall a. (Subst a, Free a) => VerboseKey -> a -> Abs a
    mkAbs (Abs Type -> VerboseKey
    forall a. Abs a -> VerboseKey
    absName Abs Type
    ub) Type
    wb)
        (Lam ArgInfo
    i Abs Term
    u, Lam ArgInfo
    _ Abs Term
    v) ->
          Term -> m Term
    forall a (m :: * -> *). (Reduce a, MonadReduce m) => a -> m a
    reduce (Type -> Term
    forall t a. Type'' t a -> a
    unEl Type
    a) m Term -> (Term -> m Term) -> m Term
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \case
            Pi Dom Type
    a Abs Type
    b -> ArgInfo -> Abs Term -> Term
    Lam ArgInfo
    i (Abs Term -> Term) -> (Term -> Abs Term) -> Term -> Term
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (VerboseKey -> Term -> Abs Term
    forall a. (Subst a, Free a) => VerboseKey -> a -> Abs a
    mkAbs (Abs Term -> VerboseKey
    forall a. Abs a -> VerboseKey
    absName Abs Term
    u)) (Term -> Term) -> m Term -> m Term
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Dom Type -> m Term -> m Term
    forall b (m :: * -> *) a.
    (AddContext b, MonadAddContext m) =>
    b -> m a -> m a
    addContext Dom Type
    a (ProblemId -> Type -> Term -> Term -> m Term
    forall (m :: * -> *).
    MonadConversion m =>
    ProblemId -> Type -> Term -> Term -> m Term
    antiUnify ProblemId
    pid (Abs Type -> Type
    forall a. Subst a => Abs a -> a
    absBody Abs Type
    b) (Abs Term -> Term
    forall a. Subst a => Abs a -> a
    absBody Abs Term
    u) (Abs Term -> Term
    forall a. Subst a => Abs a -> a
    absBody Abs Term
    v))
            Term
    _      -> m Term
    fallback
        (Var Int
    i Elims
    us, Var Int
    j Elims
    vs) | Int
    i Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    j -> m Term -> m Term
    maybeGiveUp (m Term -> m Term) -> m Term -> m Term
    forall a b. (a -> b) -> a -> b
    $ do
          Type
    a <- Int -> m Type
    forall (m :: * -> *).
    (Applicative m, MonadFail m, MonadTCEnv m) =>
    Int -> m Type
    typeOfBV Int
    i
          ProblemId -> Type -> Term -> Elims -> Elims -> m Term
    forall (m :: * -> *).
    MonadConversion m =>
    ProblemId -> Type -> Term -> Elims -> Elims -> m Term
    antiUnifyElims ProblemId
    pid Type
    a (Int -> Term
    var Int
    i) Elims
    us Elims
    vs
        -- Andreas, 2017-07-27:
        -- It seems that nothing guarantees here that the constructors are fully
        -- applied!?  Thus, @a@ could be a function type and we need the robust
        -- @getConType@ here.
        -- (Note that @patternViolation@ swallows exceptions coming from @getConType@
        -- thus, we would not see clearly if we used @getFullyAppliedConType@ instead.)
        (Con ConHead
    x ConInfo
    ci Elims
    us, Con ConHead
    y ConInfo
    _ Elims
    vs) | ConHead
    x ConHead -> ConHead -> Bool
    forall a. Eq a => a -> a -> Bool
    == ConHead
    y -> m Term -> m Term
    maybeGiveUp (m Term -> m Term) -> m Term -> m Term
    forall a b. (a -> b) -> a -> b
    $ do
          Type
    a <- m Type
    -> (((QName, Type, [Arg Term]), Type) -> m Type)
    -> Maybe ((QName, Type, [Arg Term]), Type)
    -> m Type
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe m Type
    forall {a}. m a
    abort (Type -> m Type
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Type -> m Type)
    -> (((QName, Type, [Arg Term]), Type) -> Type)
    -> ((QName, Type, [Arg Term]), Type)
    -> m Type
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((QName, Type, [Arg Term]), Type) -> Type
    forall a b. (a, b) -> b
    snd) (Maybe ((QName, Type, [Arg Term]), Type) -> m Type)
    -> m (Maybe ((QName, Type, [Arg Term]), Type)) -> m Type
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< ConHead -> Type -> m (Maybe ((QName, Type, [Arg Term]), Type))
    forall (m :: * -> *).
    PureTCM m =>
    ConHead -> Type -> m (Maybe ((QName, Type, [Arg Term]), Type))
    getConType ConHead
    x Type
    a
          ProblemId -> Type -> Term -> Elims -> Elims -> m Term
    forall (m :: * -> *).
    MonadConversion m =>
    ProblemId -> Type -> Term -> Elims -> Elims -> m Term
    antiUnifyElims ProblemId
    pid Type
    a (ConHead -> ConInfo -> Elims -> Term
    Con ConHead
    x ConInfo
    ci []) Elims
    us Elims
    vs
        (Def QName
    f [], Def QName
    g []) | QName
    f QName -> QName -> Bool
    forall a. Eq a => a -> a -> Bool
    == QName
    g -> Term -> m Term
    forall (m :: * -> *) a. Monad m => a -> m a
    return (QName -> Elims -> Term
    Def QName
    f [])
        (Def QName
    f Elims
    us, Def QName
    g Elims
    vs) | QName
    f QName -> QName -> Bool
    forall a. Eq a => a -> a -> Bool
    == QName
    g, Elims -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length Elims
    us Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Elims -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length Elims
    vs -> m Term -> m Term
    maybeGiveUp (m Term -> m Term) -> m Term -> m Term
    forall a b. (a -> b) -> a -> b
    $ do
          Type
    a <- QName -> Elims -> Elims -> m Type
    forall (m :: * -> *).
    MonadConversion m =>
    QName -> Elims -> Elims -> m Type
    computeElimHeadType QName
    f Elims
    us Elims
    vs
          ProblemId -> Type -> Term -> Elims -> Elims -> m Term
    forall (m :: * -> *).
    MonadConversion m =>
    ProblemId -> Type -> Term -> Elims -> Elims -> m Term
    antiUnifyElims ProblemId
    pid Type
    a (QName -> Elims -> Term
    Def QName
    f []) Elims
    us Elims
    vs
        (Term, Term)
    _ -> m Term
    fallback
      where
        maybeGiveUp :: m Term -> m Term
    maybeGiveUp = (Blocker -> m Term) -> m Term -> m Term
    forall (m :: * -> *) a.
    MonadBlock m =>
    (Blocker -> m a) -> m a -> m a
    catchPatternErr ((Blocker -> m Term) -> m Term -> m Term)
    -> (Blocker -> m Term) -> m Term -> m Term
    forall a b. (a -> b) -> a -> b
    $ \ Blocker
    _ -> m Term
    fallback
        abort :: m a
    abort = Blocker -> m a
    forall (m :: * -> *) a. MonadBlock m => Blocker -> m a
    patternViolation Blocker
    neverUnblock -- caught by maybeGiveUp
        fallback :: m Term
    fallback = Type -> Term -> ProblemId -> m Term
    forall (m :: * -> *).
    (MonadMetaSolver m, MonadFresh Int m) =>
    Type -> Term -> ProblemId -> m Term
    blockTermOnProblem Type
    a Term
    u ProblemId
    pid

    antiUnifyArgs :: MonadConversion m => ProblemId -> Dom Type -> Arg Term -> Arg Term -> m (Arg Term)
    antiUnifyArgs :: forall (m :: * -> *).
    MonadConversion m =>
    ProblemId -> Dom Type -> Arg Term -> Arg Term -> m (Arg Term)
    antiUnifyArgs ProblemId
    pid Dom Type
    dom Arg Term
    u Arg Term
    v
      | Bool -> Bool
    not (Modality -> Modality -> Bool
    forall a b. (LensModality a, LensModality b) => a -> b -> Bool
    sameModality (Arg Term -> Modality
    forall a. LensModality a => a -> Modality
    getModality Arg Term
    u) (Arg Term -> Modality
    forall a. LensModality a => a -> Modality
    getModality Arg Term
    v))
                  = Blocker -> m (Arg Term)
    forall (m :: * -> *) a. MonadBlock m => Blocker -> m a
    patternViolation Blocker
    neverUnblock
      | Bool
    otherwise = Arg Term -> m (Arg Term) -> m (Arg Term)
    forall (tcm :: * -> *) m a.
    (MonadTCEnv tcm, LensModality m) =>
    m -> tcm a -> tcm a
    applyModalityToContext Arg Term
    u (m (Arg Term) -> m (Arg Term)) -> m (Arg Term) -> m (Arg Term)
    forall a b. (a -> b) -> a -> b
    $
        m Bool -> m (Arg Term) -> m (Arg Term) -> m (Arg Term)
    forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
    ifM (Dom Type -> m Bool
    forall a (m :: * -> *).
    (LensRelevance a, LensSort a, PrettyTCM a, PureTCM m,
     MonadBlock m) =>
    a -> m Bool
    isIrrelevantOrPropM Dom Type
    dom)
        {-then-} (Arg Term -> m (Arg Term)
    forall (m :: * -> *) a. Monad m => a -> m a
    return Arg Term
    u)
        {-else-} ((Term -> Arg Term -> Arg Term
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ Arg Term
    u) (Term -> Arg Term) -> m Term -> m (Arg Term)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ProblemId -> Type -> Term -> Term -> m Term
    forall (m :: * -> *).
    MonadConversion m =>
    ProblemId -> Type -> Term -> Term -> m Term
    antiUnify ProblemId
    pid (Dom Type -> Type
    forall t e. Dom' t e -> e
    unDom Dom Type
    dom) (Arg Term -> Term
    forall e. Arg e -> e
    unArg Arg Term
    u) (Arg Term -> Term
    forall e. Arg e -> e
    unArg Arg Term
    v))

    antiUnifyType :: MonadConversion m => ProblemId -> Type -> Type -> m Type
    antiUnifyType :: forall (m :: * -> *).
    MonadConversion m =>
    ProblemId -> Type -> Type -> m Type
    antiUnifyType ProblemId
    pid (El Sort
    s Term
    a) (El Sort
    _ Term
    b) = m Type -> m Type
    forall (m :: * -> *) a.
    (MonadTCEnv m, HasOptions m, MonadDebug m) =>
    m a -> m a
    workOnTypes (m Type -> m Type) -> m Type -> m Type
    forall a b. (a -> b) -> a -> b
    $ Sort -> Term -> Type
    forall t a. Sort' t -> a -> Type'' t a
    El Sort
    s (Term -> Type) -> m Term -> m Type
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ProblemId -> Type -> Term -> Term -> m Term
    forall (m :: * -> *).
    MonadConversion m =>
    ProblemId -> Type -> Term -> Term -> m Term
    antiUnify ProblemId
    pid (Sort -> Type
    sort Sort
    s) Term
    a Term
    b

    antiUnifyElims :: MonadConversion m => ProblemId -> Type -> Term -> Elims -> Elims -> m Term
    antiUnifyElims :: forall (m :: * -> *).
    MonadConversion m =>
    ProblemId -> Type -> Term -> Elims -> Elims -> m Term
    antiUnifyElims ProblemId
    pid Type
    a Term
    self [] [] = Term -> m Term
    forall (m :: * -> *) a. Monad m => a -> m a
    return Term
    self
    antiUnifyElims ProblemId
    pid Type
    a Term
    self (Proj ProjOrigin
    o QName
    f : Elims
    es1) (Proj ProjOrigin
    _ QName
    g : Elims
    es2) | QName
    f QName -> QName -> Bool
    forall a. Eq a => a -> a -> Bool
    == QName
    g = do
      Maybe (Dom Type, Term, Type)
    res <- Term
    -> Type -> ProjOrigin -> QName -> m (Maybe (Dom Type, Term, Type))
    forall (m :: * -> *).
    PureTCM m =>
    Term
    -> Type -> ProjOrigin -> QName -> m (Maybe (Dom Type, Term, Type))
    projectTyped Term
    self Type
    a ProjOrigin
    o QName
    f
      case Maybe (Dom Type, Term, Type)
    res of
        Just (Dom Type
    _, Term
    self, Type
    a) -> ProblemId -> Type -> Term -> Elims -> Elims -> m Term
    forall (m :: * -> *).
    MonadConversion m =>
    ProblemId -> Type -> Term -> Elims -> Elims -> m Term
    antiUnifyElims ProblemId
    pid Type
    a Term
    self Elims
    es1 Elims
    es2
        Maybe (Dom Type, Term, Type)
    Nothing -> Blocker -> m Term
    forall (m :: * -> *) a. MonadBlock m => Blocker -> m a
    patternViolation Blocker
    neverUnblock -- can fail for projection like
    antiUnifyElims ProblemId
    pid Type
    a Term
    self (Apply Arg Term
    u : Elims
    es1) (Apply Arg Term
    v : Elims
    es2) = do
      Term -> m Term
    forall a (m :: * -> *). (Reduce a, MonadReduce m) => a -> m a
    reduce (Type -> Term
    forall t a. Type'' t a -> a
    unEl Type
    a) m Term -> (Term -> m Term) -> m Term
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \case
        Pi Dom Type
    a Abs Type
    b -> do
          Arg Term
    w <- ProblemId -> Dom Type -> Arg Term -> Arg Term -> m (Arg Term)
    forall (m :: * -> *).
    MonadConversion m =>
    ProblemId -> Dom Type -> Arg Term -> Arg Term -> m (Arg Term)
    antiUnifyArgs ProblemId
    pid Dom Type
    a Arg Term
    u Arg Term
    v
          ProblemId -> Type -> Term -> Elims -> Elims -> m Term
    forall (m :: * -> *).
    MonadConversion m =>
    ProblemId -> Type -> Term -> Elims -> Elims -> m Term
    antiUnifyElims ProblemId
    pid (Abs Type
    b Abs Type -> SubstArg Type -> Type
    forall a. Subst a => Abs a -> SubstArg a -> a
    `lazyAbsApp` Arg Term -> Term
    forall e. Arg e -> e
    unArg Arg Term
    w) (Term -> [Arg Term] -> Term
    forall t. Apply t => t -> [Arg Term] -> t
    apply Term
    self [Arg Term
    w]) Elims
    es1 Elims
    es2
        Term
    _ -> Blocker -> m Term
    forall (m :: * -> *) a. MonadBlock m => Blocker -> m a
    patternViolation Blocker
    neverUnblock
    antiUnifyElims ProblemId
    _ Type
    _ Term
    _ Elims
    _ Elims
    _ = Blocker -> m Term
    forall (m :: * -> *) a. MonadBlock m => Blocker -> m a
    patternViolation Blocker
    neverUnblock -- trigger maybeGiveUp in antiUnify

    -- | @compareElims pols a v els1 els2@ performs type-directed equality on eliminator spines.
    --   @t@ is the type of the head @v@.
    compareElims :: forall m. MonadConversion m => [Polarity] -> [IsForced] -> Type -> Term -> [Elim] -> [Elim] -> m ()
    compareElims :: forall (m :: * -> *).
    MonadConversion m =>
    [Polarity] -> [IsForced] -> Type -> Term -> Elims -> Elims -> m ()
    compareElims [Polarity]
    pols0 [IsForced]
    fors0 Type
    a Term
    v Elims
    els01 Elims
    els02 =
      VerboseKey -> Int -> VerboseKey -> m () -> m ()
    forall (m :: * -> *) a.
    MonadDebug m =>
    VerboseKey -> Int -> VerboseKey -> m a -> m a
    verboseBracket VerboseKey
    "tc.conv.elim" Int
    20 VerboseKey
    "compareElims" (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $
      (Constraint -> m () -> m ()
    forall (m :: * -> *).
    MonadConstraint m =>
    Constraint -> m () -> m ()
    catchConstraint ([Polarity]
    -> [IsForced] -> Type -> Term -> Elims -> Elims -> Constraint
    ElimCmp [Polarity]
    pols0 [IsForced]
    fors0 Type
    a Term
    v Elims
    els01 Elims
    els02) :: m () -> m ()) (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $ do
      let v1 :: Term
    v1 = Term -> Elims -> Term
    forall t. Apply t => t -> Elims -> t
    applyE Term
    v Elims
    els01
          v2 :: Term
    v2 = Term -> Elims -> Term
    forall t. Apply t => t -> Elims -> t
    applyE Term
    v Elims
    els02
          failure :: m ()
    failure = TypeError -> m ()
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCError m) =>
    TypeError -> m a
    typeError (TypeError -> m ()) -> TypeError -> m ()
    forall a b. (a -> b) -> a -> b
    $ Comparison -> Term -> Term -> CompareAs -> TypeError
    UnequalTerms Comparison
    CmpEq Term
    v1 Term
    v2 (Type -> CompareAs
    AsTermsOf Type
    a)
            -- Andreas, 2013-03-15 since one of the spines is empty, @a@
            -- is the correct type here.
      Bool -> m () -> m ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless (Elims -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null Elims
    els01) (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $ do
        VerboseKey -> Int -> TCMT IO Doc -> m ()
    forall (m :: * -> *).
    MonadDebug m =>
    VerboseKey -> Int -> TCMT IO Doc -> m ()
    reportSDoc VerboseKey
    "tc.conv.elim" Int
    25 (TCMT IO Doc -> m ()) -> TCMT IO Doc -> m ()
    forall a b. (a -> b) -> a -> b
    $ TCMT IO Doc
    "compareElims" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    $$ do
         Int -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Functor m => Int -> m Doc -> m Doc
    nest Int
    2 (TCMT IO Doc -> TCMT IO Doc) -> TCMT IO Doc -> TCMT IO Doc
    forall a b. (a -> b) -> a -> b
    $ [TCMT IO Doc] -> TCMT IO Doc
    forall (m :: * -> *) (t :: * -> *).
    (Applicative m, Foldable t) =>
    t (m Doc) -> m Doc
    vcat
          [ TCMT IO Doc
    "a     =" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> Type -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM Type
    a
          , TCMT IO Doc
    "pols0 (truncated to 10) =" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> [TCMT IO Doc] -> TCMT IO Doc
    forall (m :: * -> *) (t :: * -> *).
    (Applicative m, Foldable t) =>
    t (m Doc) -> m Doc
    hsep ((Polarity -> TCMT IO Doc) -> [Polarity] -> [TCMT IO Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map Polarity -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM ([Polarity] -> [TCMT IO Doc]) -> [Polarity] -> [TCMT IO Doc]
    forall a b. (a -> b) -> a -> b
    $ Int -> [Polarity] -> [Polarity]
    forall a. Int -> [a] -> [a]
    take Int
    10 [Polarity]
    pols0)
          , TCMT IO Doc
    "fors0 (truncated to 10) =" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> [TCMT IO Doc] -> TCMT IO Doc
    forall (m :: * -> *) (t :: * -> *).
    (Applicative m, Foldable t) =>
    t (m Doc) -> m Doc
    hsep ((IsForced -> TCMT IO Doc) -> [IsForced] -> [TCMT IO Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map IsForced -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM ([IsForced] -> [TCMT IO Doc]) -> [IsForced] -> [TCMT IO Doc]
    forall a b. (a -> b) -> a -> b
    $ Int -> [IsForced] -> [IsForced]
    forall a. Int -> [a] -> [a]
    take Int
    10 [IsForced]
    fors0)
          , TCMT IO Doc
    "v     =" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> Term -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM Term
    v
          , TCMT IO Doc
    "els01 =" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> Elims -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM Elims
    els01
          , TCMT IO Doc
    "els02 =" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> Elims -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM Elims
    els02
          ]
      case (Elims
    els01, Elims
    els02) of
        ([]         , []         ) -> () -> m ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
        ([]         , Proj{}:Elims
    _   ) -> m ()
    failure -- not impossible, see issue 821
        (Proj{}  : Elims
    _, []         ) -> m ()
    failure -- could be x.p =?= x for projection p
        ([]         , Apply{} : Elims
    _) -> m ()
    failure -- not impossible, see issue 878
        (Apply{} : Elims
    _, []         ) -> m ()
    failure
        ([]         , IApply{} : Elims
    _) -> m ()
    failure
        (IApply{} : Elims
    _, []         ) -> m ()
    failure
        (Apply{} : Elims
    _, Proj{}  : Elims
    _) -> ()
    forall a. HasCallStack => a
    __IMPOSSIBLE__ () -> m () -> m ()
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ Bool -> m ()
    forall (m :: * -> *). MonadConstraint m => Bool -> m ()
    solveAwakeConstraints' Bool
    True -- NB: popped up in issue 889
        (Proj{}  : Elims
    _, Apply{} : Elims
    _) -> ()
    forall a. HasCallStack => a
    __IMPOSSIBLE__ () -> m () -> m ()
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ Bool -> m ()
    forall (m :: * -> *). MonadConstraint m => Bool -> m ()
    solveAwakeConstraints' Bool
    True -- but should be impossible (but again in issue 1467)
        (IApply{} : Elims
    _, Proj{}  : Elims
    _) -> ()
    forall a. HasCallStack => a
    __IMPOSSIBLE__ () -> m () -> m ()
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ Bool -> m ()
    forall (m :: * -> *). MonadConstraint m => Bool -> m ()
    solveAwakeConstraints' Bool
    True
        (Proj{}  : Elims
    _, IApply{} : Elims
    _) -> ()
    forall a. HasCallStack => a
    __IMPOSSIBLE__ () -> m () -> m ()
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ Bool -> m ()
    forall (m :: * -> *). MonadConstraint m => Bool -> m ()
    solveAwakeConstraints' Bool
    True
        (IApply{} : Elims
    _, Apply{}  : Elims
    _) -> ()
    forall a. HasCallStack => a
    __IMPOSSIBLE__ () -> m () -> m ()
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ Bool -> m ()
    forall (m :: * -> *). MonadConstraint m => Bool -> m ()
    solveAwakeConstraints' Bool
    True
        (Apply{}  : Elims
    _, IApply{} : Elims
    _) -> ()
    forall a. HasCallStack => a
    __IMPOSSIBLE__ () -> m () -> m ()
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ Bool -> m ()
    forall (m :: * -> *). MonadConstraint m => Bool -> m ()
    solveAwakeConstraints' Bool
    True
        (e :: Elim' Term
    e@(IApply Term
    x1 Term
    y1 Term
    r1) : Elims
    els1, IApply Term
    x2 Term
    y2 Term
    r2 : Elims
    els2) -> do
          VerboseKey -> Int -> TCMT IO Doc -> m ()
    forall (m :: * -> *).
    MonadDebug m =>
    VerboseKey -> Int -> TCMT IO Doc -> m ()
    reportSDoc VerboseKey
    "tc.conv.elim" Int
    25 (TCMT IO Doc -> m ()) -> TCMT IO Doc -> m ()
    forall a b. (a -> b) -> a -> b
    $ TCMT IO Doc
    "compareElims IApply"
           -- Andrea: copying stuff from the Apply case..
          let (Polarity
    pol, [Polarity]
    pols) = [Polarity] -> (Polarity, [Polarity])
    nextPolarity [Polarity]
    pols0
          Type
    a  <- Type -> m Type
    forall (m :: * -> *) t.
    (MonadReduce m, MonadBlock m, IsMeta t, Reduce t) =>
    t -> m t
    abortIfBlocked Type
    a
          PathView
    va <- Type -> m PathView
    forall (m :: * -> *). HasBuiltins m => Type -> m PathView
    pathView Type
    a
          VerboseKey -> Int -> TCMT IO Doc -> m ()
    forall (m :: * -> *).
    MonadDebug m =>
    VerboseKey -> Int -> TCMT IO Doc -> m ()
    reportSDoc VerboseKey
    "tc.conv.elim.iapply" Int
    60 (TCMT IO Doc -> m ()) -> TCMT IO Doc -> m ()
    forall a b. (a -> b) -> a -> b
    $ TCMT IO Doc
    "compareElims IApply" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    $$ do
            Int -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Functor m => Int -> m Doc -> m Doc
    nest Int
    2 (TCMT IO Doc -> TCMT IO Doc) -> TCMT IO Doc -> TCMT IO Doc
    forall a b. (a -> b) -> a -> b
    $ TCMT IO Doc
    "va =" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> VerboseKey -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => VerboseKey -> m Doc
    text (Bool -> VerboseKey
    forall a. Show a => a -> VerboseKey
    show (PathView -> Bool
    isPathType PathView
    va))
          case PathView
    va of
            PathType Sort
    s QName
    path Arg Term
    l Arg Term
    bA Arg Term
    x Arg Term
    y -> do
              Type
    b <- m Type
    forall (m :: * -> *).
    (HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
    m Type
    primIntervalType
              Polarity
    -> (Comparison -> Term -> Term -> m ()) -> Term -> Term -> m ()
    forall (m :: * -> *) a.
    MonadConversion m =>
    Polarity -> (Comparison -> a -> a -> m ()) -> a -> a -> m ()
    compareWithPol Polarity
    pol ((Comparison -> Type -> Term -> Term -> m ())
    -> Type -> Comparison -> Term -> Term -> m ()
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip Comparison -> Type -> Term -> Term -> m ()
    forall (m :: * -> *).
    MonadConversion m =>
    Comparison -> Type -> Term -> Term -> m ()
    compareTerm Type
    b)
                                  Term
    r1 Term
    r2
              -- TODO: compare (x1,x2) and (y1,y2) ?
              let r :: Term
    r = Term
    r1 -- TODO Andrea:  do blocking
              Type
    codom <- m Term -> m Term -> m Type
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Type
    el' (Term -> m Term
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Term -> m Term) -> (Arg Term -> Term) -> Arg Term -> m Term
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Arg Term -> Term
    forall e. Arg e -> e
    unArg (Arg Term -> m Term) -> Arg Term -> m Term
    forall a b. (a -> b) -> a -> b
    $ Arg Term
    l) ((Term -> m Term
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Term -> m Term) -> (Arg Term -> Term) -> Arg Term -> m Term
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Arg Term -> Term
    forall e. Arg e -> e
    unArg (Arg Term -> m Term) -> Arg Term -> m Term
    forall a b. (a -> b) -> a -> b
    $ Arg Term
    bA) m Term -> m Term -> m Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <@> Term -> m Term
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Term
    r)
              [Polarity] -> [IsForced] -> Type -> Term -> Elims -> Elims -> m ()
    forall (m :: * -> *).
    MonadConversion m =>
    [Polarity] -> [IsForced] -> Type -> Term -> Elims -> Elims -> m ()
    compareElims [Polarity]
    pols [] Type
    codom -- Path non-dependent (codom `lazyAbsApp` unArg arg)
                                (Term -> Elims -> Term
    forall t. Apply t => t -> Elims -> t
    applyE Term
    v [Elim' Term
    e]) Elims
    els1 Elims
    els2
            -- We allow for functions (i : I) -> ... to also be heads of a IApply,
            -- because @etaContract@ can produce such terms
            OType t :: Type
    t@(El Sort
    _ Pi{}) -> [Polarity] -> [IsForced] -> Type -> Term -> Elims -> Elims -> m ()
    forall (m :: * -> *).
    MonadConversion m =>
    [Polarity] -> [IsForced] -> Type -> Term -> Elims -> Elims -> m ()
    compareElims [Polarity]
    pols0 [IsForced]
    fors0 Type
    t Term
    v (Arg Term -> Elim' Term
    forall a. Arg a -> Elim' a
    Apply (Term -> Arg Term
    forall e. e -> Arg e
    defaultArg Term
    r1) Elim' Term -> Elims -> Elims
    forall a. a -> [a] -> [a]
    : Elims
    els1) (Arg Term -> Elim' Term
    forall a. Arg a -> Elim' a
    Apply (Term -> Arg Term
    forall e. e -> Arg e
    defaultArg Term
    r2) Elim' Term -> Elims -> Elims
    forall a. a -> [a] -> [a]
    : Elims
    els2)

            OType Type
    t -> Blocker -> m ()
    forall (m :: * -> *) a. MonadBlock m => Blocker -> m a
    patternViolation (Type -> Blocker
    forall t. AllMetas t => t -> Blocker
    unblockOnAnyMetaIn Type
    t) -- Can we get here? We know a is not blocked.

        (Apply Arg Term
    arg1 : Elims
    els1, Apply Arg Term
    arg2 : Elims
    els2) ->
          (VerboseKey -> Int -> VerboseKey -> m () -> m ()
    forall (m :: * -> *) a.
    MonadDebug m =>
    VerboseKey -> Int -> VerboseKey -> m a -> m a
    verboseBracket VerboseKey
    "tc.conv.elim" Int
    20 VerboseKey
    "compare Apply" :: m () -> m ()) (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $ do
          VerboseKey -> Int -> TCMT IO Doc -> m ()
    forall (m :: * -> *).
    MonadDebug m =>
    VerboseKey -> Int -> TCMT IO Doc -> m ()
    reportSDoc VerboseKey
    "tc.conv.elim" Int
    10 (TCMT IO Doc -> m ()) -> TCMT IO Doc -> m ()
    forall a b. (a -> b) -> a -> b
    $ Int -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Functor m => Int -> m Doc -> m Doc
    nest Int
    2 (TCMT IO Doc -> TCMT IO Doc) -> TCMT IO Doc -> TCMT IO Doc
    forall a b. (a -> b) -> a -> b
    $ [TCMT IO Doc] -> TCMT IO Doc
    forall (m :: * -> *) (t :: * -> *).
    (Applicative m, Foldable t) =>
    t (m Doc) -> m Doc
    vcat
            [ TCMT IO Doc
    "a    =" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> Type -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM Type
    a
            , TCMT IO Doc
    "v    =" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> Term -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM Term
    v
            , TCMT IO Doc
    "arg1 =" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> Arg Term -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM Arg Term
    arg1
            , TCMT IO Doc
    "arg2 =" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> Arg Term -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM Arg Term
    arg2
            ]
          VerboseKey -> Int -> TCMT IO Doc -> m ()
    forall (m :: * -> *).
    MonadDebug m =>
    VerboseKey -> Int -> TCMT IO Doc -> m ()
    reportSDoc VerboseKey
    "tc.conv.elim" Int
    50 (TCMT IO Doc -> m ()) -> TCMT IO Doc -> m ()
    forall a b. (a -> b) -> a -> b
    $ Int -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Functor m => Int -> m Doc -> m Doc
    nest Int
    2 (TCMT IO Doc -> TCMT IO Doc) -> TCMT IO Doc -> TCMT IO Doc
    forall a b. (a -> b) -> a -> b
    $ [TCMT IO Doc] -> TCMT IO Doc
    forall (m :: * -> *) (t :: * -> *).
    (Applicative m, Foldable t) =>
    t (m Doc) -> m Doc
    vcat
            [ TCMT IO Doc
    "raw:"
            , TCMT IO Doc
    "a    =" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> Type -> TCMT IO Doc
    forall (m :: * -> *) a. (Applicative m, Pretty a) => a -> m Doc
    pretty Type
    a
            , TCMT IO Doc
    "v    =" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> Term -> TCMT IO Doc
    forall (m :: * -> *) a. (Applicative m, Pretty a) => a -> m Doc
    pretty Term
    v
            , TCMT IO Doc
    "arg1 =" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> Arg Term -> TCMT IO Doc
    forall (m :: * -> *) a. (Applicative m, Pretty a) => a -> m Doc
    pretty Arg Term
    arg1
            , TCMT IO Doc
    "arg2 =" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> Arg Term -> TCMT IO Doc
    forall (m :: * -> *) a. (Applicative m, Pretty a) => a -> m Doc
    pretty Arg Term
    arg2
            ]
          let (Polarity
    pol, [Polarity]
    pols) = [Polarity] -> (Polarity, [Polarity])
    nextPolarity [Polarity]
    pols0
              (IsForced
    for, [IsForced]
    fors) = [IsForced] -> (IsForced, [IsForced])
    nextIsForced [IsForced]
    fors0
          Type
    a <- Type -> m Type
    forall (m :: * -> *) t.
    (MonadReduce m, MonadBlock m, IsMeta t, Reduce t) =>
    t -> m t
    abortIfBlocked Type
    a
          VerboseKey -> Int -> VerboseKey -> m ()
    forall (m :: * -> *).
    MonadDebug m =>
    VerboseKey -> Int -> VerboseKey -> m ()
    reportSLn VerboseKey
    "tc.conv.elim" Int
    40 (VerboseKey -> m ()) -> VerboseKey -> m ()
    forall a b. (a -> b) -> a -> b
    $ VerboseKey
    "type is not blocked"
          case Type -> Term
    forall t a. Type'' t a -> a
    unEl Type
    a of
            (Pi (Dom{domInfo :: forall t e. Dom' t e -> ArgInfo
    domInfo = ArgInfo
    info, unDom :: forall t e. Dom' t e -> e
    unDom = Type
    b}) Abs Type
    codom) -> do
              VerboseKey -> Int -> VerboseKey -> m ()
    forall (m :: * -> *).
    MonadDebug m =>
    VerboseKey -> Int -> VerboseKey -> m ()
    reportSLn VerboseKey
    "tc.conv.elim" Int
    40 (VerboseKey -> m ()) -> VerboseKey -> m ()
    forall a b. (a -> b) -> a -> b
    $ VerboseKey
    "type is a function type"
              Maybe Term
    mlvl <- m Term -> m (Maybe Term)
    forall e (m :: * -> *) a.
    (MonadError e m, Functor m) =>
    m a -> m (Maybe a)
    tryMaybe m Term
    forall (m :: * -> *).
    (HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
    m Term
    primLevel
              let freeInCoDom :: Abs a -> Bool
    freeInCoDom (Abs VerboseKey
    _ a
    c) = Int
    0 Int -> a -> Bool
    forall a. Free a => Int -> a -> Bool
    `freeInIgnoringSorts` a
    c
                  freeInCoDom Abs a
    _         = Bool
    False
                  dependent :: Bool
    dependent = (Term -> Maybe Term
    forall a. a -> Maybe a
    Just (Type -> Term
    forall t a. Type'' t a -> a
    unEl Type
    b) Maybe Term -> Maybe Term -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Maybe Term
    mlvl) Bool -> Bool -> Bool
    && Abs Type -> Bool
    forall a. Free a => Abs a -> Bool
    freeInCoDom Abs Type
    codom
                    -- Level-polymorphism (x : Level) -> ... does not count as dependency here
                       -- NB: we could drop the free variable test and still be sound.
                       -- It is a trade-off between the administrative effort of
                       -- creating a blocking and traversing a term for free variables.
                       -- Apparently, it is believed that checking free vars is cheaper.
                       -- Andreas, 2013-05-15

    -- NEW, Andreas, 2013-05-15

              -- compare arg1 and arg2
              ProblemId
    pid <- m () -> m ProblemId
    forall (m :: * -> *) a.
    (MonadFresh ProblemId m, MonadConstraint m) =>
    m a -> m ProblemId
    newProblem_ (m () -> m ProblemId) -> m () -> m ProblemId
    forall a b. (a -> b) -> a -> b
    $ ArgInfo -> m () -> m ()
    forall (tcm :: * -> *) m a.
    (MonadTCEnv tcm, LensModality m) =>
    m -> tcm a -> tcm a
    applyModalityToContext ArgInfo
    info (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $
                  if IsForced -> Bool
    isForced IsForced
    for then
                    VerboseKey -> Int -> VerboseKey -> m ()
    forall (m :: * -> *).
    MonadDebug m =>
    VerboseKey -> Int -> VerboseKey -> m ()
    reportSLn VerboseKey
    "tc.conv.elim" Int
    40 (VerboseKey -> m ()) -> VerboseKey -> m ()
    forall a b. (a -> b) -> a -> b
    $ VerboseKey
    "argument is forced"
                  else if ArgInfo -> Bool
    forall a. LensRelevance a => a -> Bool
    isIrrelevant ArgInfo
    info then do
                    VerboseKey -> Int -> VerboseKey -> m ()
    forall (m :: * -> *).
    MonadDebug m =>
    VerboseKey -> Int -> VerboseKey -> m ()
    reportSLn VerboseKey
    "tc.conv.elim" Int
    40 (VerboseKey -> m ()) -> VerboseKey -> m ()
    forall a b. (a -> b) -> a -> b
    $ VerboseKey
    "argument is irrelevant"
                    Type -> Term -> Term -> m ()
    forall (m :: * -> *).
    MonadConversion m =>
    Type -> Term -> Term -> m ()
    compareIrrelevant Type
    b (Arg Term -> Term
    forall e. Arg e -> e
    unArg Arg Term
    arg1) (Arg Term -> Term
    forall e. Arg e -> e
    unArg Arg Term
    arg2)
                  else do
                    VerboseKey -> Int -> VerboseKey -> m ()
    forall (m :: * -> *).
    MonadDebug m =>
    VerboseKey -> Int -> VerboseKey -> m ()
    reportSLn VerboseKey
    "tc.conv.elim" Int
    40 (VerboseKey -> m ()) -> VerboseKey -> m ()
    forall a b. (a -> b) -> a -> b
    $ VerboseKey
    "argument has polarity " VerboseKey -> VerboseKey -> VerboseKey
    forall a. [a] -> [a] -> [a]
    ++ Polarity -> VerboseKey
    forall a. Show a => a -> VerboseKey
    show Polarity
    pol
                    Polarity
    -> (Comparison -> Term -> Term -> m ()) -> Term -> Term -> m ()
    forall (m :: * -> *) a.
    MonadConversion m =>
    Polarity -> (Comparison -> a -> a -> m ()) -> a -> a -> m ()
    compareWithPol Polarity
    pol ((Comparison -> Type -> Term -> Term -> m ())
    -> Type -> Comparison -> Term -> Term -> m ()
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip Comparison -> Type -> Term -> Term -> m ()
    forall (m :: * -> *).
    MonadConversion m =>
    Comparison -> Type -> Term -> Term -> m ()
    compareTerm Type
    b)
                      (Arg Term -> Term
    forall e. Arg e -> e
    unArg Arg Term
    arg1) (Arg Term -> Term
    forall e. Arg e -> e
    unArg Arg Term
    arg2)
              -- if comparison got stuck and function type is dependent, block arg
              Bool
    solved <- ProblemId -> m Bool
    forall (m :: * -> *).
    (MonadTCEnv m, ReadTCState m) =>
    ProblemId -> m Bool
    isProblemSolved ProblemId
    pid
              VerboseKey -> Int -> VerboseKey -> m ()
    forall (m :: * -> *).
    MonadDebug m =>
    VerboseKey -> Int -> VerboseKey -> m ()
    reportSLn VerboseKey
    "tc.conv.elim" Int
    40 (VerboseKey -> m ()) -> VerboseKey -> m ()
    forall a b. (a -> b) -> a -> b
    $ VerboseKey
    "solved = " VerboseKey -> VerboseKey -> VerboseKey
    forall a. [a] -> [a] -> [a]
    ++ Bool -> VerboseKey
    forall a. Show a => a -> VerboseKey
    show Bool
    solved
              Arg Term
    arg <- if Bool
    dependent Bool -> Bool -> Bool
    && Bool -> Bool
    not Bool
    solved
                     then ArgInfo -> m (Arg Term) -> m (Arg Term)
    forall (tcm :: * -> *) m a.
    (MonadTCEnv tcm, LensModality m) =>
    m -> tcm a -> tcm a
    applyModalityToContext ArgInfo
    info (m (Arg Term) -> m (Arg Term)) -> m (Arg Term) -> m (Arg Term)
    forall a b. (a -> b) -> a -> b
    $ do
                      VerboseKey -> Int -> TCMT IO Doc -> m ()
    forall (m :: * -> *).
    MonadDebug m =>
    VerboseKey -> Int -> TCMT IO Doc -> m ()
    reportSDoc VerboseKey
    "tc.conv.elims" Int
    50 (TCMT IO Doc -> m ()) -> TCMT IO Doc -> m ()
    forall a b. (a -> b) -> a -> b
    $ [TCMT IO Doc] -> TCMT IO Doc
    forall (m :: * -> *) (t :: * -> *).
    (Applicative m, Foldable t) =>
    t (m Doc) -> m Doc
    vcat ([TCMT IO Doc] -> TCMT IO Doc) -> [TCMT IO Doc] -> TCMT IO Doc
    forall a b. (a -> b) -> a -> b
    $
                        [ TCMT IO Doc
    "Trying antiUnify:"
                        , Int -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Functor m => Int -> m Doc -> m Doc
    nest Int
    2 (TCMT IO Doc -> TCMT IO Doc) -> TCMT IO Doc -> TCMT IO Doc
    forall a b. (a -> b) -> a -> b
    $ TCMT IO Doc
    "b    =" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> Type -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM Type
    b
                        , Int -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Functor m => Int -> m Doc -> m Doc
    nest Int
    2 (TCMT IO Doc -> TCMT IO Doc) -> TCMT IO Doc -> TCMT IO Doc
    forall a b. (a -> b) -> a -> b
    $ TCMT IO Doc
    "arg1 =" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> Arg Term -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM Arg Term
    arg1
                        , Int -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Functor m => Int -> m Doc -> m Doc
    nest Int
    2 (TCMT IO Doc -> TCMT IO Doc) -> TCMT IO Doc -> TCMT IO Doc
    forall a b. (a -> b) -> a -> b
    $ TCMT IO Doc
    "arg2 =" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> Arg Term -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM Arg Term
    arg2
                        ]
                      Arg Term
    arg <- (Arg Term
    arg1 Arg Term -> Term -> Arg Term
    forall (f :: * -> *) a b. Functor f => f a -> b -> f b
    $>) (Term -> Arg Term) -> m Term -> m (Arg Term)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ProblemId -> Type -> Term -> Term -> m Term
    forall (m :: * -> *).
    MonadConversion m =>
    ProblemId -> Type -> Term -> Term -> m Term
    antiUnify ProblemId
    pid Type
    b (Arg Term -> Term
    forall e. Arg e -> e
    unArg Arg Term
    arg1) (Arg Term -> Term
    forall e. Arg e -> e
    unArg Arg Term
    arg2)
                      VerboseKey -> Int -> TCMT IO Doc -> m ()
    forall (m :: * -> *).
    MonadDebug m =>
    VerboseKey -> Int -> TCMT IO Doc -> m ()
    reportSDoc VerboseKey
    "tc.conv.elims" Int
    50 (TCMT IO Doc -> m ()) -> TCMT IO Doc -> m ()
    forall a b. (a -> b) -> a -> b
    $ TCMT IO Doc -> Int -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *).
    Applicative m =>
    m Doc -> Int -> m Doc -> m Doc
    hang TCMT IO Doc
    "Anti-unification:" Int
    2 (Arg Term -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM Arg Term
    arg)
                      VerboseKey -> Int -> TCMT IO Doc -> m ()
    forall (m :: * -> *).
    MonadDebug m =>
    VerboseKey -> Int -> TCMT IO Doc -> m ()
    reportSDoc VerboseKey
    "tc.conv.elims" Int
    70 (TCMT IO Doc -> m ()) -> TCMT IO Doc -> m ()
    forall a b. (a -> b) -> a -> b
    $ Int -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Functor m => Int -> m Doc -> m Doc
    nest Int
    2 (TCMT IO Doc -> TCMT IO Doc) -> TCMT IO Doc -> TCMT IO Doc
    forall a b. (a -> b) -> a -> b
    $ TCMT IO Doc
    "raw:" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> Arg Term -> TCMT IO Doc
    forall (m :: * -> *) a. (Applicative m, Pretty a) => a -> m Doc
    pretty Arg Term
    arg
                      Arg Term -> m (Arg Term)
    forall (m :: * -> *) a. Monad m => a -> m a
    return Arg Term
    arg
                     else Arg Term -> m (Arg Term)
    forall (m :: * -> *) a. Monad m => a -> m a
    return Arg Term
    arg1
              -- continue, possibly with blocked instantiation
              [Polarity] -> [IsForced] -> Type -> Term -> Elims -> Elims -> m ()
    forall (m :: * -> *).
    MonadConversion m =>
    [Polarity] -> [IsForced] -> Type -> Term -> Elims -> Elims -> m ()
    compareElims [Polarity]
    pols [IsForced]
    fors (Abs Type
    codom Abs Type -> SubstArg Type -> Type
    forall a. Subst a => Abs a -> SubstArg a -> a
    `lazyAbsApp` Arg Term -> Term
    forall e. Arg e -> e
    unArg Arg Term
    arg) (Term -> [Arg Term] -> Term
    forall t. Apply t => t -> [Arg Term] -> t
    apply Term
    v [Arg Term
    arg]) Elims
    els1 Elims
    els2
              -- any left over constraints of arg are associated to the comparison
              VerboseKey -> Int -> VerboseKey -> m ()
    forall (m :: * -> *).
    MonadDebug m =>
    VerboseKey -> Int -> VerboseKey -> m ()
    reportSLn VerboseKey
    "tc.conv.elim" Int
    40 (VerboseKey -> m ()) -> VerboseKey -> m ()
    forall a b. (a -> b) -> a -> b
    $ VerboseKey
    "stealing constraints from problem " VerboseKey -> VerboseKey -> VerboseKey
    forall a. [a] -> [a] -> [a]
    ++ ProblemId -> VerboseKey
    forall a. Show a => a -> VerboseKey
    show ProblemId
    pid
              ProblemId -> m ()
    forall (m :: * -> *). MonadConstraint m => ProblemId -> m ()
    stealConstraints ProblemId
    pid
              {- Stealing solves this issue:

                 Does not create enough blocked tc-problems,
                 see test/fail/DontPrune.
                 (There are remaining problems which do not show up as yellow.)
                 Need to find a way to associate pid also to result of compareElims.
              -}
            Term
    a -> do
              VerboseKey -> Int -> TCMT IO Doc -> m ()
    forall (m :: * -> *).
    MonadDebug m =>
    VerboseKey -> Int -> TCMT IO Doc -> m ()
    reportSDoc VerboseKey
    "impossible" Int
    10 (TCMT IO Doc -> m ()) -> TCMT IO Doc -> m ()
    forall a b. (a -> b) -> a -> b
    $
                TCMT IO Doc
    "unexpected type when comparing apply eliminations " TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> Term -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM Term
    a
              VerboseKey -> Int -> TCMT IO Doc -> m ()
    forall (m :: * -> *).
    MonadDebug m =>
    VerboseKey -> Int -> TCMT IO Doc -> m ()
    reportSDoc VerboseKey
    "impossible" Int
    50 (TCMT IO Doc -> m ()) -> TCMT IO Doc -> m ()
    forall a b. (a -> b) -> a -> b
    $ TCMT IO Doc
    "raw type:" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> Term -> TCMT IO Doc
    forall (m :: * -> *) a. (Applicative m, Pretty a) => a -> m Doc
    pretty Term
    a
              Blocker -> m ()
    forall (m :: * -> *) a. MonadBlock m => Blocker -> m a
    patternViolation (Term -> Blocker
    forall t. AllMetas t => t -> Blocker
    unblockOnAnyMetaIn Term
    a)
              -- Andreas, 2013-10-22
              -- in case of disabled reductions (due to failing termination check)
              -- we might get stuck, so do not crash, but fail gently.
              -- __IMPOSSIBLE__

        -- case: f == f' are projections
        (Proj ProjOrigin
    o QName
    f : Elims
    els1, Proj ProjOrigin
    _ QName
    f' : Elims
    els2)
          | QName
    f QName -> QName -> Bool
    forall a. Eq a => a -> a -> Bool
    /= QName
    f'   -> TypeError -> m ()
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCError m) =>
    TypeError -> m a
    typeError (TypeError -> m ()) -> (Doc -> TypeError) -> Doc -> m ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Doc -> TypeError
    GenericDocError (Doc -> m ()) -> m Doc -> m ()
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< QName -> m Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM QName
    f m Doc -> m Doc -> m Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> m Doc
    "/=" m Doc -> m Doc -> m Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> QName -> m Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM QName
    f'
          | Bool
    otherwise -> do
            Type
    a   <- Type -> m Type
    forall (m :: * -> *) t.
    (MonadReduce m, MonadBlock m, IsMeta t, Reduce t) =>
    t -> m t
    abortIfBlocked Type
    a
            Maybe (Dom Type, Term, Type)
    res <- Term
    -> Type -> ProjOrigin -> QName -> m (Maybe (Dom Type, Term, Type))
    forall (m :: * -> *).
    PureTCM m =>
    Term
    -> Type -> ProjOrigin -> QName -> m (Maybe (Dom Type, Term, Type))
    projectTyped Term
    v Type
    a ProjOrigin
    o QName
    f -- fails only if f is proj.like but parameters cannot be retrieved
            case Maybe (Dom Type, Term, Type)
    res of
              Just (Dom Type
    _, Term
    u, Type
    t) -> do
                -- Andreas, 2015-07-01:
                -- The arguments following the principal argument of a projection
                -- are invariant.  (At least as long as we have no explicit polarity
                -- annotations.)
                [Polarity] -> [IsForced] -> Type -> Term -> Elims -> Elims -> m ()
    forall (m :: * -> *).
    MonadConversion m =>
    [Polarity] -> [IsForced] -> Type -> Term -> Elims -> Elims -> m ()
    compareElims [] [] Type
    t Term
    u Elims
    els1 Elims
    els2
              Maybe (Dom Type, Term, Type)
    Nothing -> do
                VerboseKey -> Int -> TCMT IO Doc -> m ()
    forall (m :: * -> *).
    MonadDebug m =>
    VerboseKey -> Int -> TCMT IO Doc -> m ()
    reportSDoc VerboseKey
    "tc.conv.elims" Int
    30 (TCMT IO Doc -> m ()) -> TCMT IO Doc -> m ()
    forall a b. (a -> b) -> a -> b
    $ [TCMT IO Doc] -> TCMT IO Doc
    forall (m :: * -> *) (t :: * -> *).
    (Applicative m, Foldable t) =>
    t (m Doc) -> m Doc
    sep
                  [ VerboseKey -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => VerboseKey -> m Doc
    text (VerboseKey -> TCMT IO Doc) -> VerboseKey -> TCMT IO Doc
    forall a b. (a -> b) -> a -> b
    $ VerboseKey
    "projection " VerboseKey -> VerboseKey -> VerboseKey
    forall a. [a] -> [a] -> [a]
    ++ QName -> VerboseKey
    forall a. Pretty a => a -> VerboseKey
    prettyShow QName
    f
                  , VerboseKey -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => VerboseKey -> m Doc
    text   VerboseKey
    "applied to value " TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> Term -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM Term
    v
                  , VerboseKey -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => VerboseKey -> m Doc
    text   VerboseKey
    "of unexpected type " TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> Type -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM Type
    a
                  ]
                Blocker -> m ()
    forall (m :: * -> *) a. MonadBlock m => Blocker -> m a
    patternViolation (Type -> Blocker
    forall t. AllMetas t => t -> Blocker
    unblockOnAnyMetaIn Type
    a)

    -- | "Compare" two terms in irrelevant position.  This always succeeds.
    --   However, we can dig for solutions of irrelevant metas in the
    --   terms we compare.
    --   (Certainly not the systematic solution, that'd be proof search...)
    compareIrrelevant :: MonadConversion m => Type -> Term -> Term -> m ()
    {- 2012-04-02 DontCare no longer present
    compareIrrelevant t (DontCare v) w = compareIrrelevant t v w
    compareIrrelevant t v (DontCare w) = compareIrrelevant t v w
    -}
    compareIrrelevant :: forall (m :: * -> *).
    MonadConversion m =>
    Type -> Term -> Term -> m ()
    compareIrrelevant Type
    t Term
    v0 Term
    w0 = do
      let v :: Term
    v = Term -> Term
    stripDontCare Term
    v0
          w :: Term
    w = Term -> Term
    stripDontCare Term
    w0
      VerboseKey -> Int -> TCMT IO Doc -> m ()
    forall (m :: * -> *).
    MonadDebug m =>
    VerboseKey -> Int -> TCMT IO Doc -> m ()
    reportSDoc VerboseKey
    "tc.conv.irr" Int
    20 (TCMT IO Doc -> m ()) -> TCMT IO Doc -> m ()
    forall a b. (a -> b) -> a -> b
    $ [TCMT IO Doc] -> TCMT IO Doc
    forall (m :: * -> *) (t :: * -> *).
    (Applicative m, Foldable t) =>
    t (m Doc) -> m Doc
    vcat
        [ TCMT IO Doc
    "compareIrrelevant"
        , Int -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Functor m => Int -> m Doc -> m Doc
    nest Int
    2 (TCMT IO Doc -> TCMT IO Doc) -> TCMT IO Doc -> TCMT IO Doc
    forall a b. (a -> b) -> a -> b
    $ TCMT IO Doc
    "v =" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> Term -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM Term
    v
        , Int -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Functor m => Int -> m Doc -> m Doc
    nest Int
    2 (TCMT IO Doc -> TCMT IO Doc) -> TCMT IO Doc -> TCMT IO Doc
    forall a b. (a -> b) -> a -> b
    $ TCMT IO Doc
    "w =" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> Term -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM Term
    w
        ]
      VerboseKey -> Int -> TCMT IO Doc -> m ()
    forall (m :: * -> *).
    MonadDebug m =>
    VerboseKey -> Int -> TCMT IO Doc -> m ()
    reportSDoc VerboseKey
    "tc.conv.irr" Int
    50 (TCMT IO Doc -> m ()) -> TCMT IO Doc -> m ()
    forall a b. (a -> b) -> a -> b
    $ [TCMT IO Doc] -> TCMT IO Doc
    forall (m :: * -> *) (t :: * -> *).
    (Applicative m, Foldable t) =>
    t (m Doc) -> m Doc
    vcat
        [ Int -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Functor m => Int -> m Doc -> m Doc
    nest Int
    2 (TCMT IO Doc -> TCMT IO Doc) -> TCMT IO Doc -> TCMT IO Doc
    forall a b. (a -> b) -> a -> b
    $ TCMT IO Doc
    "v =" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> Term -> TCMT IO Doc
    forall (m :: * -> *) a. (Applicative m, Pretty a) => a -> m Doc
    pretty Term
    v
        , Int -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Functor m => Int -> m Doc -> m Doc
    nest Int
    2 (TCMT IO Doc -> TCMT IO Doc) -> TCMT IO Doc -> TCMT IO Doc
    forall a b. (a -> b) -> a -> b
    $ TCMT IO Doc
    "w =" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> Term -> TCMT IO Doc
    forall (m :: * -> *) a. (Applicative m, Pretty a) => a -> m Doc
    pretty Term
    w
        ]
      Term -> Term -> m () -> m ()
    try Term
    v Term
    w (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $ Term -> Term -> m () -> m ()
    try Term
    w Term
    v (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $ () -> m ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
      where
        try :: Term -> Term -> m () -> m ()
    try (MetaV MetaId
    x Elims
    es) Term
    w m ()
    fallback = do
          MetaVariable
    mv <- MetaId -> m MetaVariable
    forall (m :: * -> *).
    (MonadFail m, ReadTCState m) =>
    MetaId -> m MetaVariable
    lookupMeta MetaId
    x
          let rel :: Relevance
    rel  = MetaVariable -> Relevance
    getMetaRelevance MetaVariable
    mv
              inst :: Bool
    inst = case MetaVariable -> MetaInstantiation
    mvInstantiation MetaVariable
    mv of
                       InstV{} -> Bool
    True
                       MetaInstantiation
    _       -> Bool
    False
          VerboseKey -> Int -> TCMT IO Doc -> m ()
    forall (m :: * -> *).
    MonadDebug m =>
    VerboseKey -> Int -> TCMT IO Doc -> m ()
    reportSDoc VerboseKey
    "tc.conv.irr" Int
    20 (TCMT IO Doc -> m ()) -> TCMT IO Doc -> m ()
    forall a b. (a -> b) -> a -> b
    $ [TCMT IO Doc] -> TCMT IO Doc
    forall (m :: * -> *) (t :: * -> *).
    (Applicative m, Foldable t) =>
    t (m Doc) -> m Doc
    vcat
            [ Int -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Functor m => Int -> m Doc -> m Doc
    nest Int
    2 (TCMT IO Doc -> TCMT IO Doc) -> TCMT IO Doc -> TCMT IO Doc
    forall a b. (a -> b) -> a -> b
    $ VerboseKey -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => VerboseKey -> m Doc
    text (VerboseKey -> TCMT IO Doc) -> VerboseKey -> TCMT IO Doc
    forall a b. (a -> b) -> a -> b
    $ VerboseKey
    "rel  = " VerboseKey -> VerboseKey -> VerboseKey
    forall a. [a] -> [a] -> [a]
    ++ Relevance -> VerboseKey
    forall a. Show a => a -> VerboseKey
    show Relevance
    rel
            , Int -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Functor m => Int -> m Doc -> m Doc
    nest Int
    2 (TCMT IO Doc -> TCMT IO Doc) -> TCMT IO Doc -> TCMT IO Doc
    forall a b. (a -> b) -> a -> b
    $ TCMT IO Doc
    "inst =" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> Bool -> TCMT IO Doc
    forall (m :: * -> *) a. (Applicative m, Pretty a) => a -> m Doc
    pretty Bool
    inst
            ]
          if Bool -> Bool
    not (Relevance -> Bool
    forall a. LensRelevance a => a -> Bool
    isIrrelevant Relevance
    rel) Bool -> Bool -> Bool
    || Bool
    inst
            then m ()
    fallback
            -- Andreas, 2016-08-08, issue #2131:
            -- Mining for solutions for irrelevant metas is not definite.
            -- Thus, in case of error, leave meta unsolved.
            else CompareDirection
    -> MetaId
    -> Elims
    -> Term
    -> CompareAs
    -> (Term -> Term -> m ())
    -> m ()
    forall (m :: * -> *).
    MonadConversion m =>
    CompareDirection
    -> MetaId
    -> Elims
    -> Term
    -> CompareAs
    -> (Term -> Term -> m ())
    -> m ()
    assignE CompareDirection
    DirEq MetaId
    x Elims
    es Term
    w (Type -> CompareAs
    AsTermsOf Type
    t) (Type -> Term -> Term -> m ()
    forall (m :: * -> *).
    MonadConversion m =>
    Type -> Term -> Term -> m ()
    compareIrrelevant Type
    t) m () -> (TCErr -> m ()) -> m ()
    forall e (m :: * -> *) a.
    MonadError e m =>
    m a -> (e -> m a) -> m a
    `catchError` \ TCErr
    _ -> m ()
    fallback
            -- the value of irrelevant or unused meta does not matter
        try Term
    v Term
    w m ()
    fallback = m ()
    fallback

    compareWithPol :: MonadConversion m => Polarity -> (Comparison -> a -> a -> m ()) -> a -> a -> m ()
    compareWithPol :: forall (m :: * -> *) a.
    MonadConversion m =>
    Polarity -> (Comparison -> a -> a -> m ()) -> a -> a -> m ()
    compareWithPol Polarity
    Invariant     Comparison -> a -> a -> m ()
    cmp a
    x a
    y = Comparison -> a -> a -> m ()
    cmp Comparison
    CmpEq a
    x a
    y
    compareWithPol Polarity
    Covariant     Comparison -> a -> a -> m ()
    cmp a
    x a
    y = Comparison -> a -> a -> m ()
    cmp Comparison
    CmpLeq a
    x a
    y
    compareWithPol Polarity
    Contravariant Comparison -> a -> a -> m ()
    cmp a
    x a
    y = Comparison -> a -> a -> m ()
    cmp Comparison
    CmpLeq a
    y a
    x
    compareWithPol Polarity
    Nonvariant    Comparison -> a -> a -> m ()
    cmp a
    x a
    y = () -> m ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

    polFromCmp :: Comparison -> Polarity
    polFromCmp :: Comparison -> Polarity
    polFromCmp Comparison
    CmpLeq = Polarity
    Covariant
    polFromCmp Comparison
    CmpEq  = Polarity
    Invariant

    -- | Type-directed equality on argument lists
    --
    compareArgs :: MonadConversion m => [Polarity] -> [IsForced] -> Type -> Term -> Args -> Args -> m ()
    compareArgs :: forall (m :: * -> *).
    MonadConversion m =>
    [Polarity]
    -> [IsForced] -> Type -> Term -> [Arg Term] -> [Arg Term] -> m ()
    compareArgs [Polarity]
    pol [IsForced]
    for Type
    a Term
    v [Arg Term]
    args1 [Arg Term]
    args2 =
      [Polarity] -> [IsForced] -> Type -> Term -> Elims -> Elims -> m ()
    forall (m :: * -> *).
    MonadConversion m =>
    [Polarity] -> [IsForced] -> Type -> Term -> Elims -> Elims -> m ()
    compareElims [Polarity]
    pol [IsForced]
    for Type
    a Term
    v ((Arg Term -> Elim' Term) -> [Arg Term] -> Elims
    forall a b. (a -> b) -> [a] -> [b]
    map Arg Term -> Elim' Term
    forall a. Arg a -> Elim' a
    Apply [Arg Term]
    args1) ((Arg Term -> Elim' Term) -> [Arg Term] -> Elims
    forall a b. (a -> b) -> [a] -> [b]
    map Arg Term -> Elim' Term
    forall a. Arg a -> Elim' a
    Apply [Arg Term]
    args2)

    ---------------------------------------------------------------------------
    -- * Types
    ---------------------------------------------------------------------------

    -- | Equality on Types
    compareType :: MonadConversion m => Comparison -> Type -> Type -> m ()
    compareType :: forall (m :: * -> *).
    MonadConversion m =>
    Comparison -> Type -> Type -> m ()
    compareType Comparison
    cmp ty1 :: Type
    ty1@(El Sort
    s1 Term
    a1) ty2 :: Type
    ty2@(El Sort
    s2 Term
    a2) =
        m () -> m ()
    forall (m :: * -> *) a.
    (MonadTCEnv m, HasOptions m, MonadDebug m) =>
    m a -> m a
    workOnTypes (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $
        VerboseKey -> Int -> VerboseKey -> m () -> m ()
    forall (m :: * -> *) a.
    MonadDebug m =>
    VerboseKey -> Int -> VerboseKey -> m a -> m a
    verboseBracket VerboseKey
    "tc.conv.type" Int
    20 VerboseKey
    "compareType" (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $ do
            VerboseKey -> Int -> TCMT IO Doc -> m ()
    forall (m :: * -> *).
    MonadDebug m =>
    VerboseKey -> Int -> TCMT IO Doc -> m ()
    reportSDoc VerboseKey
    "tc.conv.type" Int
    50 (TCMT IO Doc -> m ()) -> TCMT IO Doc -> m ()
    forall a b. (a -> b) -> a -> b
    $ [TCMT IO Doc] -> TCMT IO Doc
    forall (m :: * -> *) (t :: * -> *).
    (Applicative m, Foldable t) =>
    t (m Doc) -> m Doc
    vcat
              [ TCMT IO Doc
    "compareType" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> [TCMT IO Doc] -> TCMT IO Doc
    forall (m :: * -> *) (t :: * -> *).
    (Applicative m, Foldable t) =>
    t (m Doc) -> m Doc
    sep [ Type -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM Type
    ty1 TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> Comparison -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM Comparison
    cmp
                                           , Type -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM Type
    ty2 ]
              , [TCMT IO Doc] -> TCMT IO Doc
    forall (m :: * -> *) (t :: * -> *).
    (Applicative m, Foldable t) =>
    t (m Doc) -> m Doc
    hsep [ TCMT IO Doc
    "   sorts:", Sort -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM Sort
    s1, TCMT IO Doc
    " and ", Sort -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM Sort
    s2 ]
              ]
            Comparison -> CompareAs -> Term -> Term -> m ()
    forall (m :: * -> *).
    MonadConversion m =>
    Comparison -> CompareAs -> Term -> Term -> m ()
    compareAs Comparison
    cmp CompareAs
    AsTypes Term
    a1 Term
    a2

    leqType :: MonadConversion m => Type -> Type -> m ()
    leqType :: forall (m :: * -> *). MonadConversion m => Type -> Type -> m ()
    leqType = Comparison -> Type -> Type -> m ()
    forall (m :: * -> *).
    MonadConversion m =>
    Comparison -> Type -> Type -> m ()
    compareType Comparison
    CmpLeq

    -- | @coerce v a b@ coerces @v : a@ to type @b@, returning a @v' : b@
    --   with maybe extra hidden applications or hidden abstractions.
    --
    --   In principle, this function can host coercive subtyping, but
    --   currently it only tries to fix problems with hidden function types.
    --
    coerce :: (MonadConversion m, MonadTCM m) => Comparison -> Term -> Type -> Type -> m Term
    coerce :: forall (m :: * -> *).
    (MonadConversion m, MonadTCM m) =>
    Comparison -> Term -> Type -> Type -> m Term
    coerce Comparison
    cmp Term
    v Type
    t1 Type
    t2 = Type -> m Term -> m Term
    forall (m :: * -> *).
    (MonadMetaSolver m, MonadConstraint m, MonadFresh Int m,
     MonadFresh ProblemId m) =>
    Type -> m Term -> m Term
    blockTerm Type
    t2 (m Term -> m Term) -> m Term -> m Term
    forall a b. (a -> b) -> a -> b
    $ do
      VerboseKey -> Int -> m () -> m ()
    forall (m :: * -> *).
    MonadDebug m =>
    VerboseKey -> Int -> m () -> m ()
    verboseS VerboseKey
    "tc.conv.coerce" Int
    10 (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $ do
        (Expr
    a1,Expr
    a2) <- (Type, Type) -> m (ReifiesTo (Type, Type))
    forall i (m :: * -> *).
    (Reify i, MonadReify m) =>
    i -> m (ReifiesTo i)
    reify (Type
    t1,Type
    t2)
        let dbglvl :: Int
    dbglvl = Int
    30
        VerboseKey -> Int -> TCMT IO Doc -> m ()
    forall (m :: * -> *).
    MonadDebug m =>
    VerboseKey -> Int -> TCMT IO Doc -> m ()
    reportSDoc VerboseKey
    "tc.conv.coerce" Int
    dbglvl (TCMT IO Doc -> m ()) -> TCMT IO Doc -> m ()
    forall a b. (a -> b) -> a -> b
    $
          TCMT IO Doc
    "coerce" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> [TCMT IO Doc] -> TCMT IO Doc
    forall (m :: * -> *) (t :: * -> *).
    (Applicative m, Foldable t) =>
    t (m Doc) -> m Doc
    vcat
            [ TCMT IO Doc
    "term      v  =" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> Term -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM Term
    v
            , TCMT IO Doc
    "from type t1 =" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> Expr -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM Expr
    a1
            , TCMT IO Doc
    "to type   t2 =" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> Expr -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM Expr
    a2
            , TCMT IO Doc
    "comparison   =" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> Comparison -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM Comparison
    cmp
            ]
        VerboseKey -> Int -> TCMT IO Doc -> m ()
    forall (m :: * -> *).
    MonadDebug m =>
    VerboseKey -> Int -> TCMT IO Doc -> m ()
    reportSDoc VerboseKey
    "tc.conv.coerce" Int
    70 (TCMT IO Doc -> m ()) -> TCMT IO Doc -> m ()
    forall a b. (a -> b) -> a -> b
    $
          TCMT IO Doc
    "coerce" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> [TCMT IO Doc] -> TCMT IO Doc
    forall (m :: * -> *) (t :: * -> *).
    (Applicative m, Foldable t) =>
    t (m Doc) -> m Doc
    vcat
            [ TCMT IO Doc
    "term      v  =" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> Term -> TCMT IO Doc
    forall (m :: * -> *) a. (Applicative m, Pretty a) => a -> m Doc
    pretty Term
    v
            , TCMT IO Doc
    "from type t1 =" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> Type -> TCMT IO Doc
    forall (m :: * -> *) a. (Applicative m, Pretty a) => a -> m Doc
    pretty Type
    t1
            , TCMT IO Doc
    "to type   t2 =" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> Type -> TCMT IO Doc
    forall (m :: * -> *) a. (Applicative m, Pretty a) => a -> m Doc
    pretty Type
    t2
            , TCMT IO Doc
    "comparison   =" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> Comparison -> TCMT IO Doc
    forall (m :: * -> *) a. (Applicative m, Pretty a) => a -> m Doc
    pretty Comparison
    cmp
            ]
      -- v <$ do workOnTypes $ leqType t1 t2
      -- take off hidden/instance domains from t1 and t2
      TelV Telescope
    tel1 Type
    b1 <- Int -> (Dom Type -> Bool) -> Type -> m (TelV Type)
    forall (m :: * -> *).
    (MonadReduce m, MonadAddContext m) =>
    Int -> (Dom Type -> Bool) -> Type -> m (TelV Type)
    telViewUpTo' (-Int
    1) Dom Type -> Bool
    forall a. LensHiding a => a -> Bool
    notVisible Type
    t1
      TelV Telescope
    tel2 Type
    b2 <- Int -> (Dom Type -> Bool) -> Type -> m (TelV Type)
    forall (m :: * -> *).
    (MonadReduce m, MonadAddContext m) =>
    Int -> (Dom Type -> Bool) -> Type -> m (TelV Type)
    telViewUpTo' (-Int
    1) Dom Type -> Bool
    forall a. LensHiding a => a -> Bool
    notVisible Type
    t2
      let n :: Int
    n = Telescope -> Int
    forall a. Sized a => a -> Int
    size Telescope
    tel1 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Telescope -> Int
    forall a. Sized a => a -> Int
    size Telescope
    tel2
      -- the crude solution would be
      --   v' = λ {tel2} → v {tel1}
      -- however, that may introduce unneccessary many function types
      -- If n  > 0 and b2 is not blocked, it is safe to
      -- insert n many hidden args
      if Int
    n Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    0 then m Term
    fallback else do
        Type
    -> (Blocker -> Type -> m Term)
    -> (NotBlocked -> Type -> m Term)
    -> m Term
    forall t (m :: * -> *) a.
    (Reduce t, IsMeta t, MonadReduce m) =>
    t -> (Blocker -> t -> m a) -> (NotBlocked -> t -> m a) -> m a
    ifBlocked Type
    b2 (\ Blocker
    _ Type
    _ -> m Term
    fallback) ((NotBlocked -> Type -> m Term) -> m Term)
    -> (NotBlocked -> Type -> m Term) -> m Term
    forall a b. (a -> b) -> a -> b
    $ \ NotBlocked
    _ Type
    _ -> do
          ([Arg Term]
    args, Type
    t1') <- Int -> (Hiding -> Bool) -> Type -> m ([Arg Term], Type)
    forall (m :: * -> *).
    (PureTCM m, MonadMetaSolver m, MonadTCM m) =>
    Int -> (Hiding -> Bool) -> Type -> m ([Arg Term], Type)
    implicitArgs Int
    n Hiding -> Bool
    forall a. LensHiding a => a -> Bool
    notVisible Type
    t1
          let v' :: Term
    v' = Term
    v Term -> [Arg Term] -> Term
    forall t. Apply t => t -> [Arg Term] -> t
    `apply` [Arg Term]
    args
          Term
    v' Term -> m () -> m Term
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ (Type -> Type -> m ()) -> Term -> Type -> Type -> m ()
    forall (m :: * -> *).
    MonadConversion m =>
    (Type -> Type -> m ()) -> Term -> Type -> Type -> m ()
    coerceSize (Comparison -> Type -> Type -> m ()
    forall (m :: * -> *).
    MonadConversion m =>
    Comparison -> Type -> Type -> m ()
    compareType Comparison
    cmp) Term
    v' Type
    t1' Type
    t2
      where
        fallback :: m Term
    fallback = Term
    v Term -> m () -> m Term
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ (Type -> Type -> m ()) -> Term -> Type -> Type -> m ()
    forall (m :: * -> *).
    MonadConversion m =>
    (Type -> Type -> m ()) -> Term -> Type -> Type -> m ()
    coerceSize (Comparison -> Type -> Type -> m ()
    forall (m :: * -> *).
    MonadConversion m =>
    Comparison -> Type -> Type -> m ()
    compareType Comparison
    cmp) Term
    v Type
    t1 Type
    t2

    -- | Account for situations like @k : (Size< j) <= (Size< k + 1)@
    --
    --   Actually, the semantics is
    --   @(Size<= k) ∩ (Size< j) ⊆ rhs@
    --   which gives a disjunctive constraint.  Mmmh, looks like stuff
    --   TODO.
    --
    --   For now, we do a cheap heuristics.
    --
    coerceSize :: MonadConversion m => (Type -> Type -> m ()) -> Term -> Type -> Type -> m ()
    coerceSize :: forall (m :: * -> *).
    MonadConversion m =>
    (Type -> Type -> m ()) -> Term -> Type -> Type -> m ()
    coerceSize Type -> Type -> m ()
    leqType Term
    v Type
    t1 Type
    t2 = VerboseKey -> Int -> VerboseKey -> m () -> m ()
    forall (m :: * -> *) a.
    MonadDebug m =>
    VerboseKey -> Int -> VerboseKey -> m a -> m a
    verboseBracket VerboseKey
    "tc.conv.size.coerce" Int
    45 VerboseKey
    "coerceSize" (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $
      m () -> m ()
    forall (m :: * -> *) a.
    (MonadTCEnv m, HasOptions m, MonadDebug m) =>
    m a -> m a
    workOnTypes (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $ do
        VerboseKey -> Int -> TCMT IO Doc -> m ()
    forall (m :: * -> *).
    MonadDebug m =>
    VerboseKey -> Int -> TCMT IO Doc -> m ()
    reportSDoc VerboseKey
    "tc.conv.size.coerce" Int
    70 (TCMT IO Doc -> m ()) -> TCMT IO Doc -> m ()
    forall a b. (a -> b) -> a -> b
    $
          TCMT IO Doc
    "coerceSize" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> [TCMT IO Doc] -> TCMT IO Doc
    forall (m :: * -> *) (t :: * -> *).
    (Applicative m, Foldable t) =>
    t (m Doc) -> m Doc
    vcat
            [ TCMT IO Doc
    "term      v  =" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> Term -> TCMT IO Doc
    forall (m :: * -> *) a. (Applicative m, Pretty a) => a -> m Doc
    pretty Term
    v
            , TCMT IO Doc
    "from type t1 =" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> Type -> TCMT IO Doc
    forall (m :: * -> *) a. (Applicative m, Pretty a) => a -> m Doc
    pretty Type
    t1
            , TCMT IO Doc
    "to type   t2 =" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> Type -> TCMT IO Doc
    forall (m :: * -> *) a. (Applicative m, Pretty a) => a -> m Doc
    pretty Type
    t2
            ]
        let fallback :: m ()
    fallback = Type -> Type -> m ()
    leqType Type
    t1 Type
    t2
            done :: m ()
    done = m (Maybe BoundedSize) -> m () -> (BoundedSize -> m ()) -> m ()
    forall (m :: * -> *) a b.
    Monad m =>
    m (Maybe a) -> m b -> (a -> m b) -> m b
    caseMaybeM (Type -> m (Maybe BoundedSize)
    forall a (m :: * -> *).
    (IsSizeType a, HasOptions m, HasBuiltins m) =>
    a -> m (Maybe BoundedSize)
    isSizeType (Type -> m (Maybe BoundedSize)) -> m Type -> m (Maybe BoundedSize)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< Type -> m Type
    forall a (m :: * -> *). (Reduce a, MonadReduce m) => a -> m a
    reduce Type
    t1) m ()
    fallback ((BoundedSize -> m ()) -> m ()) -> (BoundedSize -> m ()) -> m ()
    forall a b. (a -> b) -> a -> b
    $ \ BoundedSize
    _ -> () -> m ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
        -- Andreas, 2015-07-22, Issue 1615:
        -- If t1 is a meta and t2 a type like Size< v2, we need to make sure we do not miss
        -- the constraint v < v2!
        m (Maybe BoundedSize) -> m () -> (BoundedSize -> m ()) -> m ()
    forall (m :: * -> *) a b.
    Monad m =>
    m (Maybe a) -> m b -> (a -> m b) -> m b
    caseMaybeM (Type -> m (Maybe BoundedSize)
    forall a (m :: * -> *).
    (IsSizeType a, HasOptions m, HasBuiltins m) =>
    a -> m (Maybe BoundedSize)
    isSizeType (Type -> m (Maybe BoundedSize)) -> m Type -> m (Maybe BoundedSize)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< Type -> m Type
    forall a (m :: * -> *). (Reduce a, MonadReduce m) => a -> m a
    reduce Type
    t2) m ()
    fallback ((BoundedSize -> m ()) -> m ()) -> (BoundedSize -> m ()) -> m ()
    forall a b. (a -> b) -> a -> b
    $ \ BoundedSize
    b2 -> do
          -- Andreas, 2017-01-20, issue #2329:
          -- If v is not a size suitable for the solver, like a neutral term,
          -- we can only rely on the type.
          SizeMaxView
    mv <- Term -> m SizeMaxView
    forall (m :: * -> *). PureTCM m => Term -> m SizeMaxView
    sizeMaxView Term
    v
          if (DeepSizeView -> Bool) -> SizeMaxView -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any (\case{ DOtherSize{} -> Bool
    True; DeepSizeView
    _ -> Bool
    False }) SizeMaxView
    mv then m ()
    fallback else do
          -- Andreas, 2015-02-11 do not instantiate metas here (triggers issue 1203).
          m Bool -> m () -> m ()
    forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
    unlessM (m () -> m Bool
    forall (m :: * -> *).
    (MonadConstraint m, MonadWarning m, MonadError TCErr m,
     MonadFresh ProblemId m) =>
    m () -> m Bool
    tryConversion (m () -> m Bool) -> m () -> m Bool
    forall a b. (a -> b) -> a -> b
    $ m () -> m ()
    forall (m :: * -> *) a.
    (MonadTCEnv m, HasOptions m, MonadDebug m) =>
    m a -> m a
    dontAssignMetas (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $ Type -> Type -> m ()
    leqType Type
    t1 Type
    t2) (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $ do
            -- A (most probably weaker) alternative is to just check syn.eq.
            -- ifM (snd <$> checkSyntacticEquality t1 t2) (return v) $ {- else -} do
            VerboseKey -> Int -> TCMT IO Doc -> m ()
    forall (m :: * -> *).
    MonadDebug m =>
    VerboseKey -> Int -> TCMT IO Doc -> m ()
    reportSDoc VerboseKey
    "tc.conv.size.coerce" Int
    20 (TCMT IO Doc -> m ()) -> TCMT IO Doc -> m ()
    forall a b. (a -> b) -> a -> b
    $ TCMT IO Doc
    "coercing to a size type"
            case BoundedSize
    b2 of
              -- @t2 = Size@.  We are done!
              BoundedSize
    BoundedNo -> m ()
    done
              -- @t2 = Size< v2@
              BoundedLt Term
    v2 -> do
                SizeView
    sv2 <- Term -> m SizeView
    forall (m :: * -> *).
    (HasBuiltins m, MonadTCEnv m, ReadTCState m) =>
    Term -> m SizeView
    sizeView Term
    v2
                case SizeView
    sv2 of
                  SizeView
    SizeInf     -> m ()
    done
                  OtherSize{} -> do
                    -- Andreas, 2014-06-16:
                    -- Issue 1203: For now, just treat v < v2 as suc v <= v2
                    -- TODO: Need proper < comparison
                    Term
    vinc <- Int -> Term -> m Term
    forall (m :: * -> *). HasBuiltins m => Int -> Term -> m Term
    sizeSuc Int
    1 Term
    v
                    Comparison -> Term -> Term -> m ()
    forall (m :: * -> *).
    MonadConversion m =>
    Comparison -> Term -> Term -> m ()
    compareSizes Comparison
    CmpLeq Term
    vinc Term
    v2
                    m ()
    done
                  -- @v2 = a2 + 1@: In this case, we can try @v <= a2@
                  SizeSuc Term
    a2 -> do
                    Comparison -> Term -> Term -> m ()
    forall (m :: * -> *).
    MonadConversion m =>
    Comparison -> Term -> Term -> m ()
    compareSizes Comparison
    CmpLeq Term
    v Term
    a2
                    m ()
    done  -- to pass Issue 1136

    ---------------------------------------------------------------------------
    -- * Sorts and levels
    ---------------------------------------------------------------------------

    compareLevel :: MonadConversion m => Comparison -> Level -> Level -> m ()
    compareLevel :: forall (m :: * -> *).
    MonadConversion m =>
    Comparison -> Level -> Level -> m ()
    compareLevel Comparison
    CmpLeq Level
    u Level
    v = Level -> Level -> m ()
    forall (m :: * -> *). MonadConversion m => Level -> Level -> m ()
    leqLevel Level
    u Level
    v
    compareLevel Comparison
    CmpEq  Level
    u Level
    v = Level -> Level -> m ()
    forall (m :: * -> *). MonadConversion m => Level -> Level -> m ()
    equalLevel Level
    u Level
    v

    compareSort :: MonadConversion m => Comparison -> Sort -> Sort -> m ()
    compareSort :: forall (m :: * -> *).
    MonadConversion m =>
    Comparison -> Sort -> Sort -> m ()
    compareSort Comparison
    CmpEq  = Sort -> Sort -> m ()
    forall (m :: * -> *). MonadConversion m => Sort -> Sort -> m ()
    equalSort
    compareSort Comparison
    CmpLeq = Sort -> Sort -> m ()
    forall (m :: * -> *). MonadConversion m => Sort -> Sort -> m ()
    leqSort

    -- | Check that the first sort is less or equal to the second.
    --
    --   We can put @SizeUniv@ below @Inf@, but otherwise, it is
    --   unrelated to the other universes.
    --
    leqSort :: forall m. MonadConversion m => Sort -> Sort -> m ()
    leqSort :: forall (m :: * -> *). MonadConversion m => Sort -> Sort -> m ()
    leqSort Sort
    s1 Sort
    s2 = (Constraint -> m () -> m ()
    forall (m :: * -> *).
    MonadConstraint m =>
    Constraint -> m () -> m ()
    catchConstraint (Comparison -> Sort -> Sort -> Constraint
    SortCmp Comparison
    CmpLeq Sort
    s1 Sort
    s2) :: m () -> m ()) (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $ do
      (Sort
    s1,Sort
    s2) <- (Sort, Sort) -> m (Sort, Sort)
    forall a (m :: * -> *). (Reduce a, MonadReduce m) => a -> m a
    reduce (Sort
    s1,Sort
    s2)
      let postpone :: m ()
    postpone = Blocker -> Constraint -> m ()
    forall (m :: * -> *).
    MonadConstraint m =>
    Blocker -> Constraint -> m ()
    addConstraint ((Sort, Sort) -> Blocker
    forall t. AllMetas t => t -> Blocker
    unblockOnAnyMetaIn (Sort
    s1, Sort
    s2)) (Comparison -> Sort -> Sort -> Constraint
    SortCmp Comparison
    CmpLeq Sort
    s1 Sort
    s2)
          no :: m ()
    no       = TypeError -> m ()
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCError m) =>
    TypeError -> m a
    typeError (TypeError -> m ()) -> TypeError -> m ()
    forall a b. (a -> b) -> a -> b
    $ Sort -> Sort -> TypeError
    NotLeqSort Sort
    s1 Sort
    s2
          yes :: m ()
    yes      = () -> m ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
          synEq :: m ()
    synEq    = m Bool -> m () -> m () -> m ()
    forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
    ifNotM (PragmaOptions -> Bool
    optSyntacticEquality (PragmaOptions -> Bool) -> m PragmaOptions -> m Bool
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> m PragmaOptions
    forall (m :: * -> *). HasOptions m => m PragmaOptions
    pragmaOptions) m ()
    postpone (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $ do
            ((Sort
    s1,Sort
    s2) , Bool
    equal) <- Sort -> Sort -> m ((Sort, Sort), Bool)
    forall a (m :: * -> *).
    (Instantiate a, SynEq a, MonadReduce m) =>
    a -> a -> m ((a, a), Bool)
    SynEq.checkSyntacticEquality Sort
    s1 Sort
    s2
            if | Bool
    equal     -> m ()
    yes
               | Bool
    otherwise -> m ()
    postpone
      VerboseKey -> Int -> TCMT IO Doc -> m ()
    forall (m :: * -> *).
    MonadDebug m =>
    VerboseKey -> Int -> TCMT IO Doc -> m ()
    reportSDoc VerboseKey
    "tc.conv.sort" Int
    30 (TCMT IO Doc -> m ()) -> TCMT IO Doc -> m ()
    forall a b. (a -> b) -> a -> b
    $
        [TCMT IO Doc] -> TCMT IO Doc
    forall (m :: * -> *) (t :: * -> *).
    (Applicative m, Foldable t) =>
    t (m Doc) -> m Doc
    sep [ TCMT IO Doc
    "leqSort"
            , Int -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Functor m => Int -> m Doc -> m Doc
    nest Int
    2 (TCMT IO Doc -> TCMT IO Doc) -> TCMT IO Doc -> TCMT IO Doc
    forall a b. (a -> b) -> a -> b
    $ [TCMT IO Doc] -> TCMT IO Doc
    forall (m :: * -> *) (t :: * -> *).
    (Applicative m, Foldable t) =>
    t (m Doc) -> m Doc
    fsep [ Sort -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM Sort
    s1 TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> TCMT IO Doc
    "=<"
                            , Sort -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM Sort
    s2 ]
            ]
      Bool
    propEnabled <- m Bool
    forall (m :: * -> *). HasOptions m => m Bool
    isPropEnabled
      Bool
    typeInTypeEnabled <- m Bool
    forall (m :: * -> *). HasOptions m => m Bool
    typeInType
      Bool
    omegaInOmegaEnabled <- PragmaOptions -> Bool
    optOmegaInOmega (PragmaOptions -> Bool) -> m PragmaOptions -> m Bool
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> m PragmaOptions
    forall (m :: * -> *). HasOptions m => m PragmaOptions
    pragmaOptions

      let fvsRHS :: Int -> Bool
    fvsRHS = (Int -> IntSet -> Bool
    `IntSet.member` Sort -> IntSet
    forall t. Free t => t -> IntSet
    allFreeVars Sort
    s2)
      Bool
    badRigid <- Sort
    s1 Sort -> (Int -> Bool) -> m Bool
    forall (m :: * -> *) a.
    (PureTCM m, AnyRigid a) =>
    a -> (Int -> Bool) -> m Bool
    `rigidVarsNotContainedIn` Int -> Bool
    fvsRHS

      case (Sort
    s1, Sort
    s2) of
          -- Andreas, 2018-09-03: crash on dummy sort
          (DummyS VerboseKey
    s, Sort
    _) -> VerboseKey -> m ()
    forall {m :: * -> *} {a} {b}.
    (ReportS [a], MonadDebug m, IsString a) =>
    a -> m b
    impossibleSort VerboseKey
    s
          (Sort
    _, DummyS VerboseKey
    s) -> VerboseKey -> m ()
    forall {m :: * -> *} {a} {b}.
    (ReportS [a], MonadDebug m, IsString a) =>
    a -> m b
    impossibleSort VerboseKey
    s

          -- The most basic rule: @Set l =< Set l'@ iff @l =< l'@
          (Type Level
    a  , Type Level
    b  ) -> Level -> Level -> m ()
    forall (m :: * -> *). MonadConversion m => Level -> Level -> m ()
    leqLevel Level
    a Level
    b

          -- Likewise for @Prop@
          (Prop Level
    a  , Prop Level
    b  ) -> Level -> Level -> m ()
    forall (m :: * -> *). MonadConversion m => Level -> Level -> m ()
    leqLevel Level
    a Level
    b

          -- Likewise for @SSet@
          (SSet Level
    a  , SSet Level
    b  ) -> Level -> Level -> m ()
    forall (m :: * -> *). MonadConversion m => Level -> Level -> m ()
    leqLevel Level
    a Level
    b

          -- @Prop l@ is below @Set l@
          (Prop Level
    a  , Type Level
    b  ) -> Level -> Level -> m ()
    forall (m :: * -> *). MonadConversion m => Level -> Level -> m ()
    leqLevel Level
    a Level
    b
          (Type Level
    a  , Prop Level
    b  ) -> m ()
    no

          -- @Setωᵢ@ is above all small sorts (spelling out all cases
          -- for the exhaustiveness checker)
          (Inf IsFibrant
    f Integer
    m , Inf IsFibrant
    f' Integer
    n) ->
            if IsFibrant -> IsFibrant -> Bool
    leqFib IsFibrant
    f IsFibrant
    f' Bool -> Bool -> Bool
    && (Integer
    m Integer -> Integer -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Integer
    n Bool -> Bool -> Bool
    || Bool
    typeInTypeEnabled Bool -> Bool -> Bool
    || Bool
    omegaInOmegaEnabled) then m ()
    yes else m ()
    no
          (Type{}  , Inf IsFibrant
    f Integer
    _) -> m ()
    yes
          (Prop{}  , Inf IsFibrant
    f Integer
    _) -> m ()
    yes
          (Inf IsFibrant
    f Integer
    _, Type{}  ) -> if IsFibrant
    f IsFibrant -> IsFibrant -> Bool
    forall a. Eq a => a -> a -> Bool
    == IsFibrant
    IsFibrant Bool -> Bool -> Bool
    && Bool
    typeInTypeEnabled then m ()
    yes else m ()
    no
          (Inf IsFibrant
    f Integer
    _, SSet{}  ) -> if IsFibrant
    f IsFibrant -> IsFibrant -> Bool
    forall a. Eq a => a -> a -> Bool
    == IsFibrant
    IsStrict  Bool -> Bool -> Bool
    && Bool
    typeInTypeEnabled then m ()
    yes else m ()
    no
          (Inf IsFibrant
    _ Integer
    _, Prop{}  ) -> m ()
    no

          -- @Set l@ is below @SSet l@
          (Type Level
    a  , SSet Level
    b  ) -> Level -> Level -> m ()
    forall (m :: * -> *). MonadConversion m => Level -> Level -> m ()
    leqLevel Level
    a Level
    b
          (SSet Level
    a  , Type Level
    b  ) -> m ()
    no

          -- @Prop l@ is below @SSet l@
          (Prop Level
    a  , SSet Level
    b  ) -> Level -> Level -> m ()
    forall (m :: * -> *). MonadConversion m => Level -> Level -> m ()
    leqLevel Level
    a Level
    b
          (SSet Level
    a  , Prop Level
    b  ) -> m ()
    no

          -- @SSet@ is below @SSetω@
          (SSet{}  , Inf IsFibrant
    IsStrict Integer
    _) -> m ()
    yes
          (SSet{}  , Inf IsFibrant
    IsFibrant Integer
    _) -> m ()
    no

          -- @SizeUniv@ and @Prop0@ are bottom sorts.
          -- So is @Set0@ if @Prop@ is not enabled.
          (Sort
    _       , Sort
    LockUniv) -> Sort -> Sort -> m ()
    forall (m :: * -> *). MonadConversion m => Sort -> Sort -> m ()
    equalSort Sort
    s1 Sort
    s2
          (Sort
    _       , Sort
    SizeUniv) -> Sort -> Sort -> m ()
    forall (m :: * -> *). MonadConversion m => Sort -> Sort -> m ()
    equalSort Sort
    s1 Sort
    s2
          (Sort
    _       , Prop (Max Integer
    0 [])) -> Sort -> Sort -> m ()
    forall (m :: * -> *). MonadConversion m => Sort -> Sort -> m ()
    equalSort Sort
    s1 Sort
    s2
          (Sort
    _       , Type (Max Integer
    0 []))
            | Bool -> Bool
    not Bool
    propEnabled  -> Sort -> Sort -> m ()
    forall (m :: * -> *). MonadConversion m => Sort -> Sort -> m ()
    equalSort Sort
    s1 Sort
    s2

          -- SizeUniv is unrelated to any @Set l@ or @Prop l@
          (Sort
    SizeUniv, Type{}  ) -> m ()
    no
          (Sort
    SizeUniv, Prop{}  ) -> m ()
    no
          (Sort
    SizeUniv , Inf{}  ) -> m ()
    no
          (Sort
    SizeUniv, SSet{}  ) -> m ()
    no
          (Sort
    LockUniv, Type{}  ) -> m ()
    no
          (Sort
    LockUniv, Prop{}  ) -> m ()
    no
          (Sort
    LockUniv , Inf{}  ) -> m ()
    no
          (Sort
    LockUniv, SSet{}  ) -> m ()
    no

          -- If the first sort is a small sort that rigidly depends on a
          -- variable and the second sort does not mention this variable,
          -- the second sort must be at least @Setω@.
          (Sort
    _       , Sort
    _       ) | Just (Bool
    True,IsFibrant
    f) <- Sort -> Maybe (Bool, IsFibrant)
    isSmallSort Sort
    s1 , Bool
    badRigid -> Sort -> Sort -> m ()
    forall (m :: * -> *). MonadConversion m => Sort -> Sort -> m ()
    leqSort (IsFibrant -> Integer -> Sort
    forall t. IsFibrant -> Integer -> Sort' t
    Inf IsFibrant
    f Integer
    0) Sort
    s2

          -- PiSort, FunSort, UnivSort and MetaS might reduce once we instantiate
          -- more metas, so we postpone.
          (PiSort{}, Sort
    _       ) -> m ()
    synEq
          (Sort
    _       , PiSort{}) -> m ()
    synEq
          (FunSort{}, Sort
    _      ) -> m ()
    synEq
          (Sort
    _      , FunSort{}) -> m ()
    synEq
          (UnivSort{}, Sort
    _     ) -> m ()
    synEq
          (Sort
    _     , UnivSort{}) -> m ()
    synEq
          (MetaS{} , Sort
    _       ) -> m ()
    synEq
          (Sort
    _       , MetaS{} ) -> m ()
    synEq

          -- DefS are postulated sorts, so they do not reduce.
          (DefS{} , Sort
    _     ) -> m ()
    synEq
          (Sort
    _      , DefS{}) -> m ()
    synEq

      where
      leqFib :: IsFibrant -> IsFibrant -> Bool
    leqFib IsFibrant
    IsFibrant IsFibrant
    _ = Bool
    True
      leqFib IsFibrant
    IsStrict IsFibrant
    IsStrict = Bool
    True
      leqFib IsFibrant
    _ IsFibrant
    _ = Bool
    False
      impossibleSort :: a -> m b
    impossibleSort a
    s = do
        VerboseKey -> Int -> [a] -> m ()
    forall a (m :: * -> *).
    (ReportS a, MonadDebug m) =>
    VerboseKey -> Int -> a -> m ()
    reportS VerboseKey
    "impossible" Int
    10
          [ a
    "leqSort: found dummy sort with description:"
          , a
    s
          ]
        m b
    forall a. HasCallStack => a
    __IMPOSSIBLE__

    leqLevel :: MonadConversion m => Level -> Level -> m ()
    leqLevel :: forall (m :: * -> *). MonadConversion m => Level -> Level -> m ()
    leqLevel Level
    a Level
    b = Constraint -> m () -> m ()
    forall (m :: * -> *).
    MonadConstraint m =>
    Constraint -> m () -> m ()
    catchConstraint (Comparison -> Level -> Level -> Constraint
    LevelCmp Comparison
    CmpLeq Level
    a Level
    b) (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $ do
          VerboseKey -> Int -> TCMT IO Doc -> m ()
    forall (m :: * -> *).
    MonadDebug m =>
    VerboseKey -> Int -> TCMT IO Doc -> m ()
    reportSDoc VerboseKey
    "tc.conv.level" Int
    30 (TCMT IO Doc -> m ()) -> TCMT IO Doc -> m ()
    forall a b. (a -> b) -> a -> b
    $
            TCMT IO Doc
    "compareLevel" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+>
              [TCMT IO Doc] -> TCMT IO Doc
    forall (m :: * -> *) (t :: * -> *).
    (Applicative m, Foldable t) =>
    t (m Doc) -> m Doc
    sep [ Level -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM Level
    a TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> TCMT IO Doc
    "=<"
                  , Level -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM Level
    b ]

          (Level
    a, Level
    b) <- (Level, Level) -> m (Level, Level)
    forall a (m :: * -> *). (Reduce a, MonadReduce m) => a -> m a
    reduce (Level
    a, Level
    b)
          ((Level
    a, Level
    b), Bool
    equal) <- Level -> Level -> m ((Level, Level), Bool)
    forall a (m :: * -> *).
    (Instantiate a, SynEq a, MonadReduce m) =>
    a -> a -> m ((a, a), Bool)
    SynEq.checkSyntacticEquality Level
    a Level
    b

          let notok :: m ()
    notok    = m Bool -> m () -> m ()
    forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
    unlessM m Bool
    forall (m :: * -> *). HasOptions m => m Bool
    typeInType (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $ TypeError -> m ()
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCError m) =>
    TypeError -> m a
    typeError (TypeError -> m ()) -> TypeError -> m ()
    forall a b. (a -> b) -> a -> b
    $ Sort -> Sort -> TypeError
    NotLeqSort (Level -> Sort
    forall t. Level' t -> Sort' t
    Type Level
    a) (Level -> Sort
    forall t. Level' t -> Sort' t
    Type Level
    b)
              postpone :: m ()
    postpone = Blocker -> m ()
    forall (m :: * -> *) a. MonadBlock m => Blocker -> m a
    patternViolation ((Level, Level) -> Blocker
    forall t. AllMetas t => t -> Blocker
    unblockOnAnyMetaIn (Level
    a, Level
    b))

              wrap :: m () -> m ()
    wrap m ()
    m = m ()
    m m () -> (TCErr -> m ()) -> m ()
    forall e (m :: * -> *) a.
    MonadError e m =>
    m a -> (e -> m a) -> m a
    `catchError` \case
                TypeError{} -> m ()
    notok
                TCErr
    err         -> TCErr -> m ()
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError TCErr
    err

          VerboseKey -> Int -> TCMT IO Doc -> m ()
    forall (m :: * -> *).
    MonadDebug m =>
    VerboseKey -> Int -> TCMT IO Doc -> m ()
    reportSDoc VerboseKey
    "tc.conv.level" Int
    60 (TCMT IO Doc -> m ()) -> TCMT IO Doc -> m ()
    forall a b. (a -> b) -> a -> b
    $
            TCMT IO Doc
    "checkSyntacticEquality returns" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> Bool -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM Bool
    equal
          Bool -> m () -> m ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless Bool
    equal (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $ do

          Bool
    cumulativity <- PragmaOptions -> Bool
    optCumulativity (PragmaOptions -> Bool) -> m PragmaOptions -> m Bool
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> m PragmaOptions
    forall (m :: * -> *). HasOptions m => m PragmaOptions
    pragmaOptions
          Bool
    areWeComputingOverlap <- Lens' Bool TCEnv -> m Bool
    forall (m :: * -> *) a. MonadTCEnv m => Lens' a TCEnv -> m a
    viewTC Lens' Bool TCEnv
    eConflComputingOverlap
          VerboseKey -> Int -> TCMT IO Doc -> m ()
    forall (m :: * -> *).
    MonadDebug m =>
    VerboseKey -> Int -> TCMT IO Doc -> m ()
    reportSDoc VerboseKey
    "tc.conv.level" Int
    40 (TCMT IO Doc -> m ()) -> TCMT IO Doc -> m ()
    forall a b. (a -> b) -> a -> b
    $
            TCMT IO Doc
    "compareLevelView" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+>
              [TCMT IO Doc] -> TCMT IO Doc
    forall (m :: * -> *) (t :: * -> *).
    (Applicative m, Foldable t) =>
    t (m Doc) -> m Doc
    sep [ NonEmpty (TCMT IO Doc) -> TCMT IO Doc
    forall (m :: * -> *) (t :: * -> *).
    (Applicative m, Semigroup (m Doc), Foldable t) =>
    t (m Doc) -> m Doc
    prettyList_ (NonEmpty (TCMT IO Doc) -> TCMT IO Doc)
    -> NonEmpty (TCMT IO Doc) -> TCMT IO Doc
    forall a b. (a -> b) -> a -> b
    $ (SingleLevel' Term -> TCMT IO Doc)
    -> NonEmpty (SingleLevel' Term) -> NonEmpty (TCMT IO Doc)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (Level -> TCMT IO Doc
    forall (m :: * -> *) a. (Applicative m, Pretty a) => a -> m Doc
    pretty (Level -> TCMT IO Doc)
    -> (SingleLevel' Term -> Level) -> SingleLevel' Term -> TCMT IO Doc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . SingleLevel' Term -> Level
    forall t. SingleLevel' t -> Level' t
    unSingleLevel) (NonEmpty (SingleLevel' Term) -> NonEmpty (TCMT IO Doc))
    -> NonEmpty (SingleLevel' Term) -> NonEmpty (TCMT IO Doc)
    forall a b. (a -> b) -> a -> b
    $ Level -> NonEmpty (SingleLevel' Term)
    forall t. Level' t -> NonEmpty (SingleLevel' t)
    levelMaxView Level
    a
                  , TCMT IO Doc
    "=<"
                  , NonEmpty (TCMT IO Doc) -> TCMT IO Doc
    forall (m :: * -> *) (t :: * -> *).
    (Applicative m, Semigroup (m Doc), Foldable t) =>
    t (m Doc) -> m Doc
    prettyList_ (NonEmpty (TCMT IO Doc) -> TCMT IO Doc)
    -> NonEmpty (TCMT IO Doc) -> TCMT IO Doc
    forall a b. (a -> b) -> a -> b
    $ (SingleLevel' Term -> TCMT IO Doc)
    -> NonEmpty (SingleLevel' Term) -> NonEmpty (TCMT IO Doc)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (Level -> TCMT IO Doc
    forall (m :: * -> *) a. (Applicative m, Pretty a) => a -> m Doc
    pretty (Level -> TCMT IO Doc)
    -> (SingleLevel' Term -> Level) -> SingleLevel' Term -> TCMT IO Doc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . SingleLevel' Term -> Level
    forall t. SingleLevel' t -> Level' t
    unSingleLevel) (NonEmpty (SingleLevel' Term) -> NonEmpty (TCMT IO Doc))
    -> NonEmpty (SingleLevel' Term) -> NonEmpty (TCMT IO Doc)
    forall a b. (a -> b) -> a -> b
    $ Level -> NonEmpty (SingleLevel' Term)
    forall t. Level' t -> NonEmpty (SingleLevel' t)
    levelMaxView Level
    b
                  ]

          -- Extra reduce on level atoms, but should be cheap since they are already reduced.
          Level' (Blocked Term)
    aB <- (Term -> m (Blocked Term)) -> Level -> m (Level' (Blocked Term))
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM Term -> m (Blocked Term)
    forall a (m :: * -> *).
    (Reduce a, MonadReduce m) =>
    a -> m (Blocked a)
    reduceB Level
    a
          Level' (Blocked Term)
    bB <- (Term -> m (Blocked Term)) -> Level -> m (Level' (Blocked Term))
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM Term -> m (Blocked Term)
    forall a (m :: * -> *).
    (Reduce a, MonadReduce m) =>
    a -> m (Blocked a)
    reduceB Level
    b

          m () -> m ()
    wrap (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $ case (Level' (Blocked Term) -> NonEmpty (SingleLevel' (Blocked Term))
    forall t. Level' t -> NonEmpty (SingleLevel' t)
    levelMaxView Level' (Blocked Term)
    aB, Level' (Blocked Term) -> NonEmpty (SingleLevel' (Blocked Term))
    forall t. Level' t -> NonEmpty (SingleLevel' t)
    levelMaxView Level' (Blocked Term)
    bB) of

            -- 0 ≤ any
            (SingleClosed Integer
    0 :| [] , NonEmpty (SingleLevel' (Blocked Term))
    _) -> () -> m ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

            -- any ≤ 0
            (NonEmpty (SingleLevel' (Blocked Term))
    as , SingleClosed Integer
    0 :| []) ->
              NonEmpty (SingleLevel' (Blocked Term))
    -> (SingleLevel' (Blocked Term) -> m ()) -> m ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    t a -> (a -> m b) -> m ()
    forM_ NonEmpty (SingleLevel' (Blocked Term))
    as ((SingleLevel' (Blocked Term) -> m ()) -> m ())
    -> (SingleLevel' (Blocked Term) -> m ()) -> m ()
    forall a b. (a -> b) -> a -> b
    $ \ SingleLevel' (Blocked Term)
    a' -> Level -> Level -> m ()
    forall (m :: * -> *). MonadConversion m => Level -> Level -> m ()
    equalLevel (SingleLevel' Term -> Level
    forall t. SingleLevel' t -> Level' t
    unSingleLevel (SingleLevel' Term -> Level) -> SingleLevel' Term -> Level
    forall a b. (a -> b) -> a -> b
    $ (Blocked Term -> Term)
    -> SingleLevel' (Blocked Term) -> SingleLevel' Term
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Blocked Term -> Term
    forall t a. Blocked' t a -> a
    ignoreBlocking SingleLevel' (Blocked Term)
    a') (Integer -> Level
    ClosedLevel Integer
    0)

            -- closed ≤ closed
            (SingleClosed Integer
    m :| [], SingleClosed Integer
    n :| []) -> Bool -> m () -> m ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless (Integer
    m Integer -> Integer -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Integer
    n) m ()
    notok

            -- closed ≤ b
            (SingleClosed Integer
    m :| [] , NonEmpty (SingleLevel' (Blocked Term))
    _)
              | Integer
    m Integer -> Integer -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Level -> Integer
    levelLowerBound Level
    b -> () -> m ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

            -- as ≤ neutral/closed
            (NonEmpty (SingleLevel' (Blocked Term))
    as, NonEmpty (SingleLevel' (Blocked Term))
    bs)
              | (SingleLevel' (Blocked Term) -> Bool)
    -> NonEmpty (SingleLevel' (Blocked Term)) -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all SingleLevel' (Blocked Term) -> Bool
    forall {t} {a}. SingleLevel' (Blocked' t a) -> Bool
    neutralOrClosed NonEmpty (SingleLevel' (Blocked Term))
    bs , Level -> Integer
    levelLowerBound Level
    a Integer -> Integer -> Bool
    forall a. Ord a => a -> a -> Bool
    > Level -> Integer
    levelLowerBound Level
    b -> m ()
    notok

            -- ⊔ as ≤ single
            (as :: NonEmpty (SingleLevel' (Blocked Term))
    as@(SingleLevel' (Blocked Term)
    _:|SingleLevel' (Blocked Term)
    _:[SingleLevel' (Blocked Term)]
    _), SingleLevel' (Blocked Term)
    b :| []) ->
              NonEmpty (SingleLevel' (Blocked Term))
    -> (SingleLevel' (Blocked Term) -> m ()) -> m ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    t a -> (a -> m b) -> m ()
    forM_ NonEmpty (SingleLevel' (Blocked Term))
    as ((SingleLevel' (Blocked Term) -> m ()) -> m ())
    -> (SingleLevel' (Blocked Term) -> m ()) -> m ()
    forall a b. (a -> b) -> a -> b
    $ \ SingleLevel' (Blocked Term)
    a' -> Level -> Level -> m ()
    forall (m :: * -> *). MonadConversion m => Level -> Level -> m ()
    leqLevel (SingleLevel' Term -> Level
    forall t. SingleLevel' t -> Level' t
    unSingleLevel (SingleLevel' Term -> Level) -> SingleLevel' Term -> Level
    forall a b. (a -> b) -> a -> b
    $ Blocked Term -> Term
    forall t a. Blocked' t a -> a
    ignoreBlocking (Blocked Term -> Term)
    -> SingleLevel' (Blocked Term) -> SingleLevel' Term
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> SingleLevel' (Blocked Term)
    a')
                                          (SingleLevel' Term -> Level
    forall t. SingleLevel' t -> Level' t
    unSingleLevel (SingleLevel' Term -> Level) -> SingleLevel' Term -> Level
    forall a b. (a -> b) -> a -> b
    $ Blocked Term -> Term
    forall t a. Blocked' t a -> a
    ignoreBlocking (Blocked Term -> Term)
    -> SingleLevel' (Blocked Term) -> SingleLevel' Term
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> SingleLevel' (Blocked Term)
    b)

            -- reduce constants
            (NonEmpty (SingleLevel' (Blocked Term))
    as, NonEmpty (SingleLevel' (Blocked Term))
    bs)
              | let minN :: Integer
    minN = Integer -> Integer -> Integer
    forall a. Ord a => a -> a -> a
    min ((Integer, Level) -> Integer
    forall a b. (a, b) -> a
    fst ((Integer, Level) -> Integer) -> (Integer, Level) -> Integer
    forall a b. (a -> b) -> a -> b
    $ Level -> (Integer, Level)
    levelPlusView Level
    a) ((Integer, Level) -> Integer
    forall a b. (a, b) -> a
    fst ((Integer, Level) -> Integer) -> (Integer, Level) -> Integer
    forall a b. (a -> b) -> a -> b
    $ Level -> (Integer, Level)
    levelPlusView Level
    b)
                    a' :: Level
    a'   = Level -> Maybe Level -> Level
    forall a. a -> Maybe a -> a
    fromMaybe Level
    forall a. HasCallStack => a
    __IMPOSSIBLE__ (Maybe Level -> Level) -> Maybe Level -> Level
    forall a b. (a -> b) -> a -> b
    $ Integer -> Level -> Maybe Level
    subLevel Integer
    minN Level
    a
                    b' :: Level
    b'   = Level -> Maybe Level -> Level
    forall a. a -> Maybe a -> a
    fromMaybe Level
    forall a. HasCallStack => a
    __IMPOSSIBLE__ (Maybe Level -> Level) -> Maybe Level -> Level
    forall a b. (a -> b) -> a -> b
    $ Integer -> Level -> Maybe Level
    subLevel Integer
    minN Level
    b
              , Integer
    minN Integer -> Integer -> Bool
    forall a. Ord a => a -> a -> Bool
    > Integer
    0 -> Level -> Level -> m ()
    forall (m :: * -> *). MonadConversion m => Level -> Level -> m ()
    leqLevel Level
    a' Level
    b'

            -- remove subsumed
            -- Andreas, 2014-04-07: This is ok if we do not go back to equalLevel
            (NonEmpty (SingleLevel' (Blocked Term))
    as, NonEmpty (SingleLevel' (Blocked Term))
    bs)
              | (subsumed :: [SingleLevel' (Blocked Term)]
    subsumed@(SingleLevel' (Blocked Term)
    _:[SingleLevel' (Blocked Term)]
    _) , [SingleLevel' (Blocked Term)]
    as') <- (SingleLevel' (Blocked Term) -> Bool)
    -> NonEmpty (SingleLevel' (Blocked Term))
    -> ([SingleLevel' (Blocked Term)], [SingleLevel' (Blocked Term)])
    forall a. (a -> Bool) -> NonEmpty a -> ([a], [a])
    List1.partition (SingleLevel' Term -> Bool
    isSubsumed (SingleLevel' Term -> Bool)
    -> (SingleLevel' (Blocked Term) -> SingleLevel' Term)
    -> SingleLevel' (Blocked Term)
    -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Blocked Term -> Term)
    -> SingleLevel' (Blocked Term) -> SingleLevel' Term
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Blocked Term -> Term
    forall t a. Blocked' t a -> a
    ignoreBlocking) NonEmpty (SingleLevel' (Blocked Term))
    as
              -> Level -> Level -> m ()
    forall (m :: * -> *). MonadConversion m => Level -> Level -> m ()
    leqLevel ([SingleLevel' Term] -> Level
    unSingleLevels ([SingleLevel' Term] -> Level) -> [SingleLevel' Term] -> Level
    forall a b. (a -> b) -> a -> b
    $ ((SingleLevel' (Blocked Term) -> SingleLevel' Term)
    -> [SingleLevel' (Blocked Term)] -> [SingleLevel' Term]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((SingleLevel' (Blocked Term) -> SingleLevel' Term)
     -> [SingleLevel' (Blocked Term)] -> [SingleLevel' Term])
    -> ((Blocked Term -> Term)
        -> SingleLevel' (Blocked Term) -> SingleLevel' Term)
    -> (Blocked Term -> Term)
    -> [SingleLevel' (Blocked Term)]
    -> [SingleLevel' Term]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Blocked Term -> Term)
    -> SingleLevel' (Blocked Term) -> SingleLevel' Term
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap) Blocked Term -> Term
    forall t a. Blocked' t a -> a
    ignoreBlocking [SingleLevel' (Blocked Term)]
    as') Level
    b
              where
                isSubsumed :: SingleLevel' Term -> Bool
    isSubsumed SingleLevel' Term
    a = (SingleLevel' Term -> Bool) -> NonEmpty (SingleLevel' Term) -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any (SingleLevel' Term -> SingleLevel' Term -> Bool
    `subsumes` SingleLevel' Term
    a) (NonEmpty (SingleLevel' Term) -> Bool)
    -> NonEmpty (SingleLevel' Term) -> Bool
    forall a b. (a -> b) -> a -> b
    $ ((SingleLevel' (Blocked Term) -> SingleLevel' Term)
    -> NonEmpty (SingleLevel' (Blocked Term))
    -> NonEmpty (SingleLevel' Term)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((SingleLevel' (Blocked Term) -> SingleLevel' Term)
     -> NonEmpty (SingleLevel' (Blocked Term))
     -> NonEmpty (SingleLevel' Term))
    -> ((Blocked Term -> Term)
        -> SingleLevel' (Blocked Term) -> SingleLevel' Term)
    -> (Blocked Term -> Term)
    -> NonEmpty (SingleLevel' (Blocked Term))
    -> NonEmpty (SingleLevel' Term)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Blocked Term -> Term)
    -> SingleLevel' (Blocked Term) -> SingleLevel' Term
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap) Blocked Term -> Term
    forall t a. Blocked' t a -> a
    ignoreBlocking NonEmpty (SingleLevel' (Blocked Term))
    bs

                subsumes :: SingleLevel -> SingleLevel -> Bool
                subsumes :: SingleLevel' Term -> SingleLevel' Term -> Bool
    subsumes (SingleClosed Integer
    m)        (SingleClosed Integer
    n)        = Integer
    m Integer -> Integer -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Integer
    n
                subsumes (SinglePlus (Plus Integer
    m Term
    _)) (SingleClosed Integer
    n)        = Integer
    m Integer -> Integer -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Integer
    n
                subsumes (SinglePlus (Plus Integer
    m Term
    a)) (SinglePlus (Plus Integer
    n Term
    b)) = Term
    a Term -> Term -> Bool
    forall a. Eq a => a -> a -> Bool
    == Term
    b Bool -> Bool -> Bool
    && Integer
    m Integer -> Integer -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Integer
    n
                subsumes SingleLevel' Term
    _ SingleLevel' Term
    _ = Bool
    False

            -- as ≤ _l x₁ .. xₙ ⊔ bs
            -- We can solve _l := λ x₁ .. xₙ -> as ⊔ (_l' x₁ .. xₙ)
            -- (where _l' is a new metavariable)
            (NonEmpty (SingleLevel' (Blocked Term))
    as , NonEmpty (SingleLevel' (Blocked Term))
    bs)
              | Bool
    cumulativity
              , Bool -> Bool
    not Bool
    areWeComputingOverlap
              , Just (mb :: Term
    mb@(MetaV MetaId
    x Elims
    es) , [SingleLevel' Term]
    bs') <- [SingleLevel' Term] -> Maybe (Term, [SingleLevel' Term])
    singleMetaView ([SingleLevel' Term] -> Maybe (Term, [SingleLevel' Term]))
    -> [SingleLevel' Term] -> Maybe (Term, [SingleLevel' Term])
    forall a b. (a -> b) -> a -> b
    $ ((SingleLevel' (Blocked Term) -> SingleLevel' Term)
    -> [SingleLevel' (Blocked Term)] -> [SingleLevel' Term]
    forall a b. (a -> b) -> [a] -> [b]
    map ((SingleLevel' (Blocked Term) -> SingleLevel' Term)
     -> [SingleLevel' (Blocked Term)] -> [SingleLevel' Term])
    -> ((Blocked Term -> Term)
        -> SingleLevel' (Blocked Term) -> SingleLevel' Term)
    -> (Blocked Term -> Term)
    -> [SingleLevel' (Blocked Term)]
    -> [SingleLevel' Term]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Blocked Term -> Term)
    -> SingleLevel' (Blocked Term) -> SingleLevel' Term
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap) Blocked Term -> Term
    forall t a. Blocked' t a -> a
    ignoreBlocking (NonEmpty (SingleLevel' (Blocked Term))
    -> [SingleLevel' (Blocked Term)]
    forall a. NonEmpty a -> [a]
    List1.toList NonEmpty (SingleLevel' (Blocked Term))
    bs)
              , [SingleLevel' Term] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [SingleLevel' Term]
    bs' Bool -> Bool -> Bool
    || (Term, Level) -> Bool
    forall a. AllMetas a => a -> Bool
    noMetas (Level -> Term
    Level Level
    a , [SingleLevel' Term] -> Level
    unSingleLevels [SingleLevel' Term]
    bs') -> do
                MetaVariable
    mv <- MetaId -> m MetaVariable
    forall (m :: * -> *).
    (MonadFail m, ReadTCState m) =>
    MetaId -> m MetaVariable
    lookupMeta MetaId
    x
                -- Jesper, 2019-10-13: abort if this is an interaction
                -- meta or a generalizable meta
                Bool
    abort <- (Maybe InteractionId -> Bool
    forall a. Maybe a -> Bool
    isJust (Maybe InteractionId -> Bool) -> m (Maybe InteractionId) -> m Bool
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> MetaId -> m (Maybe InteractionId)
    forall (m :: * -> *).
    ReadTCState m =>
    MetaId -> m (Maybe InteractionId)
    isInteractionMeta MetaId
    x) m Bool -> m Bool -> m Bool
    forall (m :: * -> *). Monad m => m Bool -> m Bool -> m Bool
    `or2M`
                         ((DoGeneralize -> DoGeneralize -> Bool
    forall a. Eq a => a -> a -> Bool
    == DoGeneralize
    YesGeneralizeVar) (DoGeneralize -> Bool) -> m DoGeneralize -> m Bool
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> MetaId -> m DoGeneralize
    forall (m :: * -> *).
    (ReadTCState m, MonadFail m) =>
    MetaId -> m DoGeneralize
    isGeneralizableMeta MetaId
    x)
                if | Bool
    abort -> m ()
    postpone
                   | Bool
    otherwise -> do
                      MetaId
    x' <- case MetaVariable -> Judgement MetaId
    mvJudgement MetaVariable
    mv of
                        IsSort{} -> m MetaId
    forall a. HasCallStack => a
    __IMPOSSIBLE__
                        HasType MetaId
    _ Comparison
    cmp Type
    t -> do
                          TelV Telescope
    tel Type
    t' <- Type -> m (TelV Type)
    forall (m :: * -> *).
    (MonadReduce m, MonadAddContext m) =>
    Type -> m (TelV Type)
    telView Type
    t
                          Frozen
    -> MetaInfo
    -> MetaPriority
    -> Permutation
    -> Judgement ()
    -> m MetaId
    forall (m :: * -> *) a.
    MonadMetaSolver m =>
    Frozen
    -> MetaInfo
    -> MetaPriority
    -> Permutation
    -> Judgement a
    -> m MetaId
    newMeta Frozen
    Instantiable (MetaVariable -> MetaInfo
    mvInfo MetaVariable
    mv) MetaPriority
    normalMetaPriority (Int -> Permutation
    idP (Int -> Permutation) -> Int -> Permutation
    forall a b. (a -> b) -> a -> b
    $ Telescope -> Int
    forall a. Sized a => a -> Int
    size Telescope
    tel) (Judgement () -> m MetaId) -> Judgement () -> m MetaId
    forall a b. (a -> b) -> a -> b
    $ () -> Comparison -> Type -> Judgement ()
    forall a. a -> Comparison -> Type -> Judgement a
    HasType () Comparison
    cmp Type
    t
                      VerboseKey -> Int -> TCMT IO Doc -> m ()
    forall (m :: * -> *).
    MonadDebug m =>
    VerboseKey -> Int -> TCMT IO Doc -> m ()
    reportSDoc VerboseKey
    "tc.conv.level" Int
    20 (TCMT IO Doc -> m ()) -> TCMT IO Doc -> m ()
    forall a b. (a -> b) -> a -> b
    $ [TCMT IO Doc] -> TCMT IO Doc
    forall (m :: * -> *) (t :: * -> *).
    (Applicative m, Foldable t) =>
    t (m Doc) -> m Doc
    fsep
                        [ TCMT IO Doc
    "attempting to solve" , Term -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM (MetaId -> Elims -> Term
    MetaV MetaId
    x Elims
    es) , TCMT IO Doc
    "to the maximum of"
                        , Term -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM (Level -> Term
    Level Level
    a) , TCMT IO Doc
    "and the fresh meta" , Term -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM (MetaId -> Elims -> Term
    MetaV MetaId
    x' Elims
    es)
                        ]
                      Level -> Level -> m ()
    forall (m :: * -> *). MonadConversion m => Level -> Level -> m ()
    equalLevel (Term -> Level
    forall t. t -> Level' t
    atomicLevel Term
    mb) (Level -> m ()) -> Level -> m ()
    forall a b. (a -> b) -> a -> b
    $ Level -> Level -> Level
    levelLub Level
    a (Term -> Level
    forall t. t -> Level' t
    atomicLevel (Term -> Level) -> Term -> Level
    forall a b. (a -> b) -> a -> b
    $ MetaId -> Elims -> Term
    MetaV MetaId
    x' Elims
    es)

            -- Andreas, 2016-09-28: This simplification loses the solution lzero.
            -- Thus, it is invalid.
            -- See test/Succeed/LevelMetaLeqNeutralLevel.agda.
            -- -- [a] ≤ [neutral]
            -- ([a@(Plus n _)], [b@(Plus m NeutralLevel{})])
            --   | m == n -> equalLevel' (Max [a]) (Max [b])
            --   -- Andreas, 2014-04-07: This call to equalLevel is ok even if we removed
            --   -- subsumed terms from the lhs.

            -- anything else
            (NonEmpty (SingleLevel' (Blocked Term)),
     NonEmpty (SingleLevel' (Blocked Term)))
    _ | (Level, Level) -> Bool
    forall a. AllMetas a => a -> Bool
    noMetas (Level
    a, Level
    b) -> m ()
    notok
              | Bool
    otherwise      -> m ()
    postpone
          where
            neutralOrClosed :: SingleLevel' (Blocked' t a) -> Bool
    neutralOrClosed (SingleClosed Integer
    _)                   = Bool
    True
            neutralOrClosed (SinglePlus (Plus Integer
    _ NotBlocked{})) = Bool
    True
            neutralOrClosed SingleLevel' (Blocked' t a)
    _                                  = Bool
    False

            -- Is there exactly one @MetaV@ in the list of single levels?
            singleMetaView :: [SingleLevel] -> Maybe (Term, [SingleLevel])
            singleMetaView :: [SingleLevel' Term] -> Maybe (Term, [SingleLevel' Term])
    singleMetaView (SinglePlus (Plus Integer
    0 l :: Term
    l@(MetaV MetaId
    m Elims
    es)) : [SingleLevel' Term]
    ls)
              | (SingleLevel' Term -> Bool) -> [SingleLevel' Term] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all (Bool -> Bool
    not (Bool -> Bool)
    -> (SingleLevel' Term -> Bool) -> SingleLevel' Term -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . SingleLevel' Term -> Bool
    isMetaLevel) [SingleLevel' Term]
    ls = (Term, [SingleLevel' Term]) -> Maybe (Term, [SingleLevel' Term])
    forall a. a -> Maybe a
    Just (Term
    l,[SingleLevel' Term]
    ls)
            singleMetaView (SingleLevel' Term
    l : [SingleLevel' Term]
    ls)
              | Bool -> Bool
    not (Bool -> Bool) -> Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $ SingleLevel' Term -> Bool
    isMetaLevel SingleLevel' Term
    l = ([SingleLevel' Term] -> [SingleLevel' Term])
    -> (Term, [SingleLevel' Term]) -> (Term, [SingleLevel' Term])
    forall (a :: * -> * -> *) b c d.
    Arrow a =>
    a b c -> a (d, b) (d, c)
    second (SingleLevel' Term
    lSingleLevel' Term -> [SingleLevel' Term] -> [SingleLevel' Term]
    forall a. a -> [a] -> [a]
    :) ((Term, [SingleLevel' Term]) -> (Term, [SingleLevel' Term]))
    -> Maybe (Term, [SingleLevel' Term])
    -> Maybe (Term, [SingleLevel' Term])
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [SingleLevel' Term] -> Maybe (Term, [SingleLevel' Term])
    singleMetaView [SingleLevel' Term]
    ls
            singleMetaView [SingleLevel' Term]
    _ = Maybe (Term, [SingleLevel' Term])
    forall a. Maybe a
    Nothing

            isMetaLevel :: SingleLevel -> Bool
            isMetaLevel :: SingleLevel' Term -> Bool
    isMetaLevel (SinglePlus (Plus Integer
    _ MetaV{})) = Bool
    True
            isMetaLevel SingleLevel' Term
    _                             = Bool
    False

    equalLevel :: forall m. MonadConversion m => Level -> Level -> m ()
    equalLevel :: forall (m :: * -> *). MonadConversion m => Level -> Level -> m ()
    equalLevel Level
    a Level
    b = do
      VerboseKey -> Int -> TCMT IO Doc -> m ()
    forall (m :: * -> *).
    MonadDebug m =>
    VerboseKey -> Int -> TCMT IO Doc -> m ()
    reportSDoc VerboseKey
    "tc.conv.level" Int
    50 (TCMT IO Doc -> m ()) -> TCMT IO Doc -> m ()
    forall a b. (a -> b) -> a -> b
    $ [TCMT IO Doc] -> TCMT IO Doc
    forall (m :: * -> *) (t :: * -> *).
    (Applicative m, Foldable t) =>
    t (m Doc) -> m Doc
    sep [ TCMT IO Doc
    "equalLevel", Int -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Functor m => Int -> m Doc -> m Doc
    nest Int
    2 (TCMT IO Doc -> TCMT IO Doc) -> TCMT IO Doc -> TCMT IO Doc
    forall a b. (a -> b) -> a -> b
    $ TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Functor m => m Doc -> m Doc
    parens (TCMT IO Doc -> TCMT IO Doc) -> TCMT IO Doc -> TCMT IO Doc
    forall a b. (a -> b) -> a -> b
    $ Level -> TCMT IO Doc
    forall (m :: * -> *) a. (Applicative m, Pretty a) => a -> m Doc
    pretty Level
    a, Int -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Functor m => Int -> m Doc -> m Doc
    nest Int
    2 (TCMT IO Doc -> TCMT IO Doc) -> TCMT IO Doc -> TCMT IO Doc
    forall a b. (a -> b) -> a -> b
    $ TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Functor m => m Doc -> m Doc
    parens (TCMT IO Doc -> TCMT IO Doc) -> TCMT IO Doc -> TCMT IO Doc
    forall a b. (a -> b) -> a -> b
    $ Level -> TCMT IO Doc
    forall (m :: * -> *) a. (Applicative m, Pretty a) => a -> m Doc
    pretty Level
    b ]
      -- Andreas, 2013-10-31 remove common terms (that don't contain metas!)
      -- THAT's actually UNSOUND when metas are instantiated, because
      --     max a b == max a c  does not imply  b == c
      -- as <- return $ Set.fromList $ closed0 as
      -- bs <- return $ Set.fromList $ closed0 bs
      -- let cs = Set.filter (not . hasMeta) $ Set.intersection as bs
      -- as <- return $ Set.toList $ as Set.\\ cs
      -- bs <- return $ Set.toList $ bs Set.\\ cs

      VerboseKey -> Int -> TCMT IO Doc -> m ()
    forall (m :: * -> *).
    MonadDebug m =>
    VerboseKey -> Int -> TCMT IO Doc -> m ()
    reportSDoc VerboseKey
    "tc.conv.level" Int
    40 (TCMT IO Doc -> m ()) -> TCMT IO Doc -> m ()
    forall a b. (a -> b) -> a -> b
    $
        [TCMT IO Doc] -> TCMT IO Doc
    forall (m :: * -> *) (t :: * -> *).
    (Applicative m, Foldable t) =>
    t (m Doc) -> m Doc
    sep [ TCMT IO Doc
    "equalLevel"
            , [TCMT IO Doc] -> TCMT IO Doc
    forall (m :: * -> *) (t :: * -> *).
    (Applicative m, Foldable t) =>
    t (m Doc) -> m Doc
    vcat [ Int -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Functor m => Int -> m Doc -> m Doc
    nest Int
    2 (TCMT IO Doc -> TCMT IO Doc) -> TCMT IO Doc -> TCMT IO Doc
    forall a b. (a -> b) -> a -> b
    $ [TCMT IO Doc] -> TCMT IO Doc
    forall (m :: * -> *) (t :: * -> *).
    (Applicative m, Foldable t) =>
    t (m Doc) -> m Doc
    sep [ Level -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM Level
    a TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> TCMT IO Doc
    "=="
                                  , Level -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM Level
    b
                                  ]
                   ]
            ]

      (Level
    a, Level
    b) <- (Level, Level) -> m (Level, Level)
    forall a (m :: * -> *). (Reduce a, MonadReduce m) => a -> m a
    reduce (Level
    a, Level
    b)
      ((Level
    a, Level
    b), Bool
    equal) <- Level -> Level -> m ((Level, Level), Bool)
    forall a (m :: * -> *).
    (Instantiate a, SynEq a, MonadReduce m) =>
    a -> a -> m ((a, a), Bool)
    SynEq.checkSyntacticEquality Level
    a Level
    b
      VerboseKey -> Int -> TCMT IO Doc -> m ()
    forall (m :: * -> *).
    MonadDebug m =>
    VerboseKey -> Int -> TCMT IO Doc -> m ()
    reportSDoc VerboseKey
    "tc.conv.level" Int
    60 (TCMT IO Doc -> m ()) -> TCMT IO Doc -> m ()
    forall a b. (a -> b) -> a -> b
    $
        TCMT IO Doc
    "checkSyntacticEquality returns" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> Bool -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM Bool
    equal
      Bool -> m () -> m ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless Bool
    equal (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $ do

      -- Jesper, 2014-02-02 remove terms that certainly do not contribute
      -- to the maximum
      let (Level
    a', Level
    b') = Level -> Level -> (Level, Level)
    removeSubsumed Level
    a Level
    b

      let notok :: m ()
    notok    = m Bool -> m () -> m ()
    forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
    unlessM m Bool
    forall (m :: * -> *). HasOptions m => m Bool
    typeInType m ()
    notOk
          notOk :: m ()
    notOk    = TypeError -> m ()
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCError m) =>
    TypeError -> m a
    typeError (TypeError -> m ()) -> TypeError -> m ()
    forall a b. (a -> b) -> a -> b
    $ Comparison -> Level -> Level -> TypeError
    UnequalLevel Comparison
    CmpEq Level
    a' Level
    b'
          postpone :: m ()
    postpone = do
            VerboseKey -> Int -> TCMT IO Doc -> m ()
    forall (m :: * -> *).
    MonadDebug m =>
    VerboseKey -> Int -> TCMT IO Doc -> m ()
    reportSDoc VerboseKey
    "tc.conv.level" Int
    30 (TCMT IO Doc -> m ()) -> TCMT IO Doc -> m ()
    forall a b. (a -> b) -> a -> b
    $ TCMT IO Doc -> Int -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *).
    Applicative m =>
    m Doc -> Int -> m Doc -> m Doc
    hang TCMT IO Doc
    "postponing:" Int
    2 (TCMT IO Doc -> TCMT IO Doc) -> TCMT IO Doc -> TCMT IO Doc
    forall a b. (a -> b) -> a -> b
    $ TCMT IO Doc -> Int -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *).
    Applicative m =>
    m Doc -> Int -> m Doc -> m Doc
    hang (Level -> TCMT IO Doc
    forall (m :: * -> *) a. (Applicative m, Pretty a) => a -> m Doc
    pretty Level
    a' TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> TCMT IO Doc
    "==") Int
    0 (Level -> TCMT IO Doc
    forall (m :: * -> *) a. (Applicative m, Pretty a) => a -> m Doc
    pretty Level
    b')
            Blocker -> m ()
    forall (m :: * -> *) a. MonadBlock m => Blocker -> m a
    patternViolation ((Level, Level) -> Blocker
    forall t. AllMetas t => t -> Blocker
    unblockOnAnyMetaIn (Level
    a', Level
    b'))

      VerboseKey -> Int -> TCMT IO Doc -> m ()
    forall (m :: * -> *).
    MonadDebug m =>
    VerboseKey -> Int -> TCMT IO Doc -> m ()
    reportSDoc VerboseKey
    "tc.conv.level" Int
    50 (TCMT IO Doc -> m ()) -> TCMT IO Doc -> m ()
    forall a b. (a -> b) -> a -> b
    $
        [TCMT IO Doc] -> TCMT IO Doc
    forall (m :: * -> *) (t :: * -> *).
    (Applicative m, Foldable t) =>
    t (m Doc) -> m Doc
    sep [ TCMT IO Doc
    "equalLevel (w/o subsumed)"
            , [TCMT IO Doc] -> TCMT IO Doc
    forall (m :: * -> *) (t :: * -> *).
    (Applicative m, Foldable t) =>
    t (m Doc) -> m Doc
    vcat [ Int -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Functor m => Int -> m Doc -> m Doc
    nest Int
    2 (TCMT IO Doc -> TCMT IO Doc) -> TCMT IO Doc -> TCMT IO Doc
    forall a b. (a -> b) -> a -> b
    $ [TCMT IO Doc] -> TCMT IO Doc
    forall (m :: * -> *) (t :: * -> *).
    (Applicative m, Foldable t) =>
    t (m Doc) -> m Doc
    sep [ Level -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM Level
    a' TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> TCMT IO Doc
    "=="
                                  , Level -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM Level
    b'
                                  ]
                   ]
            ]

      let as :: NonEmpty (SingleLevel' Term)
    as  = Level -> NonEmpty (SingleLevel' Term)
    forall t. Level' t -> NonEmpty (SingleLevel' t)
    levelMaxView Level
    a'
          bs :: NonEmpty (SingleLevel' Term)
    bs  = Level -> NonEmpty (SingleLevel' Term)
    forall t. Level' t -> NonEmpty (SingleLevel' t)
    levelMaxView Level
    b'
      VerboseKey -> Int -> TCMT IO Doc -> m ()
    forall (m :: * -> *).
    MonadDebug m =>
    VerboseKey -> Int -> TCMT IO Doc -> m ()
    reportSDoc VerboseKey
    "tc.conv.level" Int
    50 (TCMT IO Doc -> m ()) -> TCMT IO Doc -> m ()
    forall a b. (a -> b) -> a -> b
    $
        [TCMT IO Doc] -> TCMT IO Doc
    forall (m :: * -> *) (t :: * -> *).
    (Applicative m, Foldable t) =>
    t (m Doc) -> m Doc
    sep [ VerboseKey -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => VerboseKey -> m Doc
    text VerboseKey
    "equalLevel"
            , [TCMT IO Doc] -> TCMT IO Doc
    forall (m :: * -> *) (t :: * -> *).
    (Applicative m, Foldable t) =>
    t (m Doc) -> m Doc
    vcat [ Int -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Functor m => Int -> m Doc -> m Doc
    nest Int
    2 (TCMT IO Doc -> TCMT IO Doc) -> TCMT IO Doc -> TCMT IO Doc
    forall a b. (a -> b) -> a -> b
    $ [TCMT IO Doc] -> TCMT IO Doc
    forall (m :: * -> *) (t :: * -> *).
    (Applicative m, Foldable t) =>
    t (m Doc) -> m Doc
    sep [ NonEmpty (TCMT IO Doc) -> TCMT IO Doc
    forall (m :: * -> *) (t :: * -> *).
    (Applicative m, Semigroup (m Doc), Foldable t) =>
    t (m Doc) -> m Doc
    prettyList_ (NonEmpty (TCMT IO Doc) -> TCMT IO Doc)
    -> NonEmpty (TCMT IO Doc) -> TCMT IO Doc
    forall a b. (a -> b) -> a -> b
    $ (SingleLevel' Term -> TCMT IO Doc)
    -> NonEmpty (SingleLevel' Term) -> NonEmpty (TCMT IO Doc)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (Level -> TCMT IO Doc
    forall (m :: * -> *) a. (Applicative m, Pretty a) => a -> m Doc
    pretty (Level -> TCMT IO Doc)
    -> (SingleLevel' Term -> Level) -> SingleLevel' Term -> TCMT IO Doc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . SingleLevel' Term -> Level
    forall t. SingleLevel' t -> Level' t
    unSingleLevel) NonEmpty (SingleLevel' Term)
    as
                                  , TCMT IO Doc
    "=="
                                  , NonEmpty (TCMT IO Doc) -> TCMT IO Doc
    forall (m :: * -> *) (t :: * -> *).
    (Applicative m, Semigroup (m Doc), Foldable t) =>
    t (m Doc) -> m Doc
    prettyList_ (NonEmpty (TCMT IO Doc) -> TCMT IO Doc)
    -> NonEmpty (TCMT IO Doc) -> TCMT IO Doc
    forall a b. (a -> b) -> a -> b
    $ (SingleLevel' Term -> TCMT IO Doc)
    -> NonEmpty (SingleLevel' Term) -> NonEmpty (TCMT IO Doc)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (Level -> TCMT IO Doc
    forall (m :: * -> *) a. (Applicative m, Pretty a) => a -> m Doc
    pretty (Level -> TCMT IO Doc)
    -> (SingleLevel' Term -> Level) -> SingleLevel' Term -> TCMT IO Doc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . SingleLevel' Term -> Level
    forall t. SingleLevel' t -> Level' t
    unSingleLevel) NonEmpty (SingleLevel' Term)
    bs
                                  ]
                   ]
            ]

      VerboseKey -> Int -> TCMT IO Doc -> m ()
    forall (m :: * -> *).
    MonadDebug m =>
    VerboseKey -> Int -> TCMT IO Doc -> m ()
    reportSDoc VerboseKey
    "tc.conv.level" Int
    80 (TCMT IO Doc -> m ()) -> TCMT IO Doc -> m ()
    forall a b. (a -> b) -> a -> b
    $
        [TCMT IO Doc] -> TCMT IO Doc
    forall (m :: * -> *) (t :: * -> *).
    (Applicative m, Foldable t) =>
    t (m Doc) -> m Doc
    sep [ VerboseKey -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => VerboseKey -> m Doc
    text VerboseKey
    "equalLevel"
            , [TCMT IO Doc] -> TCMT IO Doc
    forall (m :: * -> *) (t :: * -> *).
    (Applicative m, Foldable t) =>
    t (m Doc) -> m Doc
    vcat [ Int -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Functor m => Int -> m Doc -> m Doc
    nest Int
    2 (TCMT IO Doc -> TCMT IO Doc) -> TCMT IO Doc -> TCMT IO Doc
    forall a b. (a -> b) -> a -> b
    $ [TCMT IO Doc] -> TCMT IO Doc
    forall (m :: * -> *) (t :: * -> *).
    (Applicative m, Foldable t) =>
    t (m Doc) -> m Doc
    sep [ NonEmpty (TCMT IO Doc) -> TCMT IO Doc
    forall (m :: * -> *) (t :: * -> *).
    (Applicative m, Semigroup (m Doc), Foldable t) =>
    t (m Doc) -> m Doc
    prettyList_ (NonEmpty (TCMT IO Doc) -> TCMT IO Doc)
    -> NonEmpty (TCMT IO Doc) -> TCMT IO Doc
    forall a b. (a -> b) -> a -> b
    $ (SingleLevel' Term -> TCMT IO Doc)
    -> NonEmpty (SingleLevel' Term) -> NonEmpty (TCMT IO Doc)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (VerboseKey -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => VerboseKey -> m Doc
    text (VerboseKey -> TCMT IO Doc)
    -> (SingleLevel' Term -> VerboseKey)
    -> SingleLevel' Term
    -> TCMT IO Doc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Level -> VerboseKey
    forall a. Show a => a -> VerboseKey
    show (Level -> VerboseKey)
    -> (SingleLevel' Term -> Level) -> SingleLevel' Term -> VerboseKey
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . SingleLevel' Term -> Level
    forall t. SingleLevel' t -> Level' t
    unSingleLevel) NonEmpty (SingleLevel' Term)
    as
                                  , TCMT IO Doc
    "=="
                                  , NonEmpty (TCMT IO Doc) -> TCMT IO Doc
    forall (m :: * -> *) (t :: * -> *).
    (Applicative m, Semigroup (m Doc), Foldable t) =>
    t (m Doc) -> m Doc
    prettyList_ (NonEmpty (TCMT IO Doc) -> TCMT IO Doc)
    -> NonEmpty (TCMT IO Doc) -> TCMT IO Doc
    forall a b. (a -> b) -> a -> b
    $ (SingleLevel' Term -> TCMT IO Doc)
    -> NonEmpty (SingleLevel' Term) -> NonEmpty (TCMT IO Doc)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (VerboseKey -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => VerboseKey -> m Doc
    text (VerboseKey -> TCMT IO Doc)
    -> (SingleLevel' Term -> VerboseKey)
    -> SingleLevel' Term
    -> TCMT IO Doc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Level -> VerboseKey
    forall a. Show a => a -> VerboseKey
    show (Level -> VerboseKey)
    -> (SingleLevel' Term -> Level) -> SingleLevel' Term -> VerboseKey
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . SingleLevel' Term -> Level
    forall t. SingleLevel' t -> Level' t
    unSingleLevel) NonEmpty (SingleLevel' Term)
    bs
                                  ]
                   ]
            ]

      -- Extra reduce on level atoms, but should be cheap since they are already reduced.
      NonEmpty (SingleLevel' (Blocked Term))
    as <- ((SingleLevel' Term -> m (SingleLevel' (Blocked Term)))
    -> NonEmpty (SingleLevel' Term)
    -> m (NonEmpty (SingleLevel' (Blocked Term)))
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM ((SingleLevel' Term -> m (SingleLevel' (Blocked Term)))
     -> NonEmpty (SingleLevel' Term)
     -> m (NonEmpty (SingleLevel' (Blocked Term))))
    -> ((Term -> m (Blocked Term))
        -> SingleLevel' Term -> m (SingleLevel' (Blocked Term)))
    -> (Term -> m (Blocked Term))
    -> NonEmpty (SingleLevel' Term)
    -> m (NonEmpty (SingleLevel' (Blocked Term)))
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Term -> m (Blocked Term))
    -> SingleLevel' Term -> m (SingleLevel' (Blocked Term))
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM) Term -> m (Blocked Term)
    forall a (m :: * -> *).
    (Reduce a, MonadReduce m) =>
    a -> m (Blocked a)
    reduceB NonEmpty (SingleLevel' Term)
    as
      NonEmpty (SingleLevel' (Blocked Term))
    bs <- ((SingleLevel' Term -> m (SingleLevel' (Blocked Term)))
    -> NonEmpty (SingleLevel' Term)
    -> m (NonEmpty (SingleLevel' (Blocked Term)))
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM ((SingleLevel' Term -> m (SingleLevel' (Blocked Term)))
     -> NonEmpty (SingleLevel' Term)
     -> m (NonEmpty (SingleLevel' (Blocked Term))))
    -> ((Term -> m (Blocked Term))
        -> SingleLevel' Term -> m (SingleLevel' (Blocked Term)))
    -> (Term -> m (Blocked Term))
    -> NonEmpty (SingleLevel' Term)
    -> m (NonEmpty (SingleLevel' (Blocked Term)))
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Term -> m (Blocked Term))
    -> SingleLevel' Term -> m (SingleLevel' (Blocked Term))
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM) Term -> m (Blocked Term)
    forall a (m :: * -> *).
    (Reduce a, MonadReduce m) =>
    a -> m (Blocked a)
    reduceB NonEmpty (SingleLevel' Term)
    bs

      Constraint -> m () -> m ()
    forall (m :: * -> *).
    MonadConstraint m =>
    Constraint -> m () -> m ()
    catchConstraint (Comparison -> Level -> Level -> Constraint
    LevelCmp Comparison
    CmpEq Level
    a Level
    b) (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $ case (NonEmpty (SingleLevel' (Blocked Term))
    as, NonEmpty (SingleLevel' (Blocked Term))
    bs) of

            -- closed == closed
            (SingleClosed Integer
    m :| [], SingleClosed Integer
    n :| [])
              | Integer
    m Integer -> Integer -> Bool
    forall a. Eq a => a -> a -> Bool
    == Integer
    n    -> () -> m ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
              | Bool
    otherwise -> m ()
    notok

            -- closed == neutral
            (SingleClosed Integer
    m :| [] , NonEmpty (SingleLevel' (Blocked Term))
    bs) | (SingleLevel' (Blocked Term) -> Bool)
    -> NonEmpty (SingleLevel' (Blocked Term)) -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any SingleLevel' (Blocked Term) -> Bool
    forall {t} {a}. SingleLevel' (Blocked' t a) -> Bool
    isNeutral NonEmpty (SingleLevel' (Blocked Term))
    bs -> m ()
    notok
            (NonEmpty (SingleLevel' (Blocked Term))
    as , SingleClosed Integer
    n :| []) | (SingleLevel' (Blocked Term) -> Bool)
    -> NonEmpty (SingleLevel' (Blocked Term)) -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any SingleLevel' (Blocked Term) -> Bool
    forall {t} {a}. SingleLevel' (Blocked' t a) -> Bool
    isNeutral NonEmpty (SingleLevel' (Blocked Term))
    as -> m ()
    notok

            -- closed == b
            (SingleClosed Integer
    m :| [] , NonEmpty (SingleLevel' (Blocked Term))
    _) | Integer
    m Integer -> Integer -> Bool
    forall a. Ord a => a -> a -> Bool
    < Level -> Integer
    levelLowerBound Level
    b -> m ()
    notok
            (NonEmpty (SingleLevel' (Blocked Term))
    _ , SingleClosed Integer
    n :| []) | Integer
    n Integer -> Integer -> Bool
    forall a. Ord a => a -> a -> Bool
    < Level -> Integer
    levelLowerBound Level
    a -> m ()
    notok

            -- 0 == a ⊔ b
            (SingleClosed Integer
    0 :| [] , bs :: NonEmpty (SingleLevel' (Blocked Term))
    bs@(SingleLevel' (Blocked Term)
    _:|SingleLevel' (Blocked Term)
    _:[SingleLevel' (Blocked Term)]
    _)) ->
              NonEmpty (SingleLevel' (Blocked Term))
    -> (SingleLevel' (Blocked Term) -> m ()) -> m ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    t a -> (a -> m b) -> m ()
    forM_ NonEmpty (SingleLevel' (Blocked Term))
    bs ((SingleLevel' (Blocked Term) -> m ()) -> m ())
    -> (SingleLevel' (Blocked Term) -> m ()) -> m ()
    forall a b. (a -> b) -> a -> b
    $ \ SingleLevel' (Blocked Term)
    b' ->  Level -> Level -> m ()
    forall (m :: * -> *). MonadConversion m => Level -> Level -> m ()
    equalLevel (Integer -> Level
    ClosedLevel Integer
    0) (SingleLevel' Term -> Level
    forall t. SingleLevel' t -> Level' t
    unSingleLevel (SingleLevel' Term -> Level) -> SingleLevel' Term -> Level
    forall a b. (a -> b) -> a -> b
    $ Blocked Term -> Term
    forall t a. Blocked' t a -> a
    ignoreBlocking (Blocked Term -> Term)
    -> SingleLevel' (Blocked Term) -> SingleLevel' Term
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> SingleLevel' (Blocked Term)
    b')
            (as :: NonEmpty (SingleLevel' (Blocked Term))
    as@(SingleLevel' (Blocked Term)
    _:|SingleLevel' (Blocked Term)
    _:[SingleLevel' (Blocked Term)]
    _) , SingleClosed Integer
    0 :| []) ->
              NonEmpty (SingleLevel' (Blocked Term))
    -> (SingleLevel' (Blocked Term) -> m ()) -> m ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    t a -> (a -> m b) -> m ()
    forM_ NonEmpty (SingleLevel' (Blocked Term))
    as ((SingleLevel' (Blocked Term) -> m ()) -> m ())
    -> (SingleLevel' (Blocked Term) -> m ()) -> m ()
    forall a b. (a -> b) -> a -> b
    $ \ SingleLevel' (Blocked Term)
    a' -> Level -> Level -> m ()
    forall (m :: * -> *). MonadConversion m => Level -> Level -> m ()
    equalLevel (SingleLevel' Term -> Level
    forall t. SingleLevel' t -> Level' t
    unSingleLevel (SingleLevel' Term -> Level) -> SingleLevel' Term -> Level
    forall a b. (a -> b) -> a -> b
    $ Blocked Term -> Term
    forall t a. Blocked' t a -> a
    ignoreBlocking (Blocked Term -> Term)
    -> SingleLevel' (Blocked Term) -> SingleLevel' Term
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> SingleLevel' (Blocked Term)
    a') (Integer -> Level
    ClosedLevel Integer
    0)

            -- meta == any
            (SinglePlus (Plus Integer
    k Blocked Term
    a) :| [] , SinglePlus (Plus Integer
    l Blocked Term
    b) :| [])
              -- there is only a potential choice when k == l
              | MetaV MetaId
    x Elims
    as' <- Blocked Term -> Term
    forall t a. Blocked' t a -> a
    ignoreBlocking Blocked Term
    a
              , MetaV MetaId
    y Elims
    bs' <- Blocked Term -> Term
    forall t a. Blocked' t a -> a
    ignoreBlocking Blocked Term
    b
              , Integer
    k Integer -> Integer -> Bool
    forall a. Eq a => a -> a -> Bool
    == Integer
    l -> do
                  Type
    lvl <- m Type
    forall (m :: * -> *). HasBuiltins m => m Type
    levelType
                  CompareAs -> Term -> Term -> m ()
    forall (m :: * -> *).
    MonadConversion m =>
    CompareAs -> Term -> Term -> m ()
    equalAtom (Type -> CompareAs
    AsTermsOf Type
    lvl) (MetaId -> Elims -> Term
    MetaV MetaId
    x Elims
    as') (MetaId -> Elims -> Term
    MetaV MetaId
    y Elims
    bs')
            (SinglePlus (Plus Integer
    k Blocked Term
    a) :| [] , NonEmpty (SingleLevel' (Blocked Term))
    _)
              | MetaV MetaId
    x Elims
    as' <- Blocked Term -> Term
    forall t a. Blocked' t a -> a
    ignoreBlocking Blocked Term
    a
              , Just Level
    b' <- Integer -> Level -> Maybe Level
    subLevel Integer
    k Level
    b -> MetaId -> Elims -> Level -> m ()
    forall {m :: * -> *}.
    (MonadMetaSolver m, MonadWarning m, MonadStatistics m,
     MonadFresh ProblemId m, MonadFresh Int m) =>
    MetaId -> Elims -> Level -> m ()
    meta MetaId
    x Elims
    as' Level
    b'
            (NonEmpty (SingleLevel' (Blocked Term))
    _ , SinglePlus (Plus Integer
    l Blocked Term
    b) :| [])
              | MetaV MetaId
    y Elims
    bs' <- Blocked Term -> Term
    forall t a. Blocked' t a -> a
    ignoreBlocking Blocked Term
    b
              , Just Level
    a' <- Integer -> Level -> Maybe Level
    subLevel Integer
    l Level
    a -> MetaId -> Elims -> Level -> m ()
    forall {m :: * -> *}.
    (MonadMetaSolver m, MonadWarning m, MonadStatistics m,
     MonadFresh ProblemId m, MonadFresh Int m) =>
    MetaId -> Elims -> Level -> m ()
    meta MetaId
    y Elims
    bs' Level
    a'

            -- a' ⊔ b == b
            (NonEmpty (SingleLevel' (Blocked Term)),
     NonEmpty (SingleLevel' (Blocked Term)))
    _ | Just Level
    a' <- Level -> Level -> Maybe Level
    levelMaxDiff Level
    a Level
    b
              , Level
    b Level -> Level -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Integer -> Level
    ClosedLevel Integer
    0 -> Level -> Level -> m ()
    forall (m :: * -> *). MonadConversion m => Level -> Level -> m ()
    leqLevel Level
    a' Level
    b

            -- a == b' ⊔ a
            (NonEmpty (SingleLevel' (Blocked Term)),
     NonEmpty (SingleLevel' (Blocked Term)))
    _ | Just Level
    b' <- Level -> Level -> Maybe Level
    levelMaxDiff Level
    b Level
    a
              , Level
    a Level -> Level -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Integer -> Level
    ClosedLevel Integer
    0 -> Level -> Level -> m ()
    forall (m :: * -> *). MonadConversion m => Level -> Level -> m ()
    leqLevel Level
    b' Level
    a

            -- neutral/closed == neutral/closed
            (NonEmpty (SingleLevel' (Blocked Term))
    as , NonEmpty (SingleLevel' (Blocked Term))
    bs)
              | (SingleLevel' (Blocked Term) -> Bool)
    -> NonEmpty (SingleLevel' (Blocked Term)) -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all SingleLevel' (Blocked Term) -> Bool
    forall {t} {a}. SingleLevel' (Blocked' t a) -> Bool
    isNeutralOrClosed (NonEmpty (SingleLevel' (Blocked Term))
    as NonEmpty (SingleLevel' (Blocked Term))
    -> NonEmpty (SingleLevel' (Blocked Term))
    -> NonEmpty (SingleLevel' (Blocked Term))
    forall a. Semigroup a => a -> a -> a
    <> NonEmpty (SingleLevel' (Blocked Term))
    bs)
              -- Andreas, 2013-10-31: There could be metas in neutral levels (see Issue 930).
              -- Should not we postpone there as well?  Yes!
              , Bool -> Bool
    not ((SingleLevel' (Blocked Term) -> Bool)
    -> NonEmpty (SingleLevel' (Blocked Term)) -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any SingleLevel' (Blocked Term) -> Bool
    forall {a} {t}. AllMetas a => SingleLevel' (Blocked' t a) -> Bool
    hasMeta (NonEmpty (SingleLevel' (Blocked Term))
    as NonEmpty (SingleLevel' (Blocked Term))
    -> NonEmpty (SingleLevel' (Blocked Term))
    -> NonEmpty (SingleLevel' (Blocked Term))
    forall a. Semigroup a => a -> a -> a
    <> NonEmpty (SingleLevel' (Blocked Term))
    bs))
              , NonEmpty (SingleLevel' (Blocked Term)) -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length NonEmpty (SingleLevel' (Blocked Term))
    as Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == NonEmpty (SingleLevel' (Blocked Term)) -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length NonEmpty (SingleLevel' (Blocked Term))
    bs -> do
                  VerboseKey -> Int -> VerboseKey -> m ()
    forall (m :: * -> *).
    MonadDebug m =>
    VerboseKey -> Int -> VerboseKey -> m ()
    reportSLn VerboseKey
    "tc.conv.level" Int
    60 (VerboseKey -> m ()) -> VerboseKey -> m ()
    forall a b. (a -> b) -> a -> b
    $ VerboseKey
    "equalLevel: all are neutral or closed"
                  (SingleLevel' (Blocked Term)
     -> SingleLevel' (Blocked Term) -> m ())
    -> NonEmpty (SingleLevel' (Blocked Term))
    -> NonEmpty (SingleLevel' (Blocked Term))
    -> m ()
    forall (m :: * -> *) a b c.
    Applicative m =>
    (a -> b -> m c) -> List1 a -> List1 b -> m ()
    List1.zipWithM_ (Term -> Term -> m ()
    forall {m :: * -> *}.
    (MonadMetaSolver m, MonadWarning m, MonadStatistics m,
     MonadFresh ProblemId m, MonadFresh Int m) =>
    Term -> Term -> m ()
    (===) (Term -> Term -> m ())
    -> (SingleLevel' (Blocked Term) -> Term)
    -> SingleLevel' (Blocked Term)
    -> SingleLevel' (Blocked Term)
    -> m ()
    forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
    `on` Level -> Term
    levelTm (Level -> Term)
    -> (SingleLevel' (Blocked Term) -> Level)
    -> SingleLevel' (Blocked Term)
    -> Term
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . SingleLevel' Term -> Level
    forall t. SingleLevel' t -> Level' t
    unSingleLevel (SingleLevel' Term -> Level)
    -> (SingleLevel' (Blocked Term) -> SingleLevel' Term)
    -> SingleLevel' (Blocked Term)
    -> Level
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Blocked Term -> Term)
    -> SingleLevel' (Blocked Term) -> SingleLevel' Term
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Blocked Term -> Term
    forall t a. Blocked' t a -> a
    ignoreBlocking) NonEmpty (SingleLevel' (Blocked Term))
    as NonEmpty (SingleLevel' (Blocked Term))
    bs

            -- more cases?
            (NonEmpty (SingleLevel' (Blocked Term)),
     NonEmpty (SingleLevel' (Blocked Term)))
    _ | (Term, Term) -> Bool
    forall a. AllMetas a => a -> Bool
    noMetas (Level -> Term
    Level Level
    a , Level -> Term
    Level Level
    b) -> m ()
    notok
              | Bool
    otherwise                   -> m ()
    postpone

          where
            Term
    a === :: Term -> Term -> m ()
    === Term
    b = m Bool -> m () -> m ()
    forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
    unlessM m Bool
    forall (m :: * -> *). HasOptions m => m Bool
    typeInType (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $ do
              Type
    lvl <- m Type
    forall (m :: * -> *). HasBuiltins m => m Type
    levelType
              CompareAs -> Term -> Term -> m ()
    forall (m :: * -> *).
    MonadConversion m =>
    CompareAs -> Term -> Term -> m ()
    equalAtom (Type -> CompareAs
    AsTermsOf Type
    lvl) Term
    a Term
    b

            -- perform assignment (MetaV x as) := b
            meta :: MetaId -> Elims -> Level -> m ()
    meta MetaId
    x Elims
    as Level
    b = do
              VerboseKey -> Int -> VerboseKey -> m ()
    forall (m :: * -> *).
    MonadDebug m =>
    VerboseKey -> Int -> VerboseKey -> m ()
    reportSLn VerboseKey
    "tc.meta.level" Int
    30 (VerboseKey -> m ()) -> VerboseKey -> m ()
    forall a b. (a -> b) -> a -> b
    $ VerboseKey
    "Assigning meta level"
              VerboseKey -> Int -> TCMT IO Doc -> m ()
    forall (m :: * -> *).
    MonadDebug m =>
    VerboseKey -> Int -> TCMT IO Doc -> m ()
    reportSDoc VerboseKey
    "tc.meta.level" Int
    50 (TCMT IO Doc -> m ()) -> TCMT IO Doc -> m ()
    forall a b. (a -> b) -> a -> b
    $ TCMT IO Doc
    "meta" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> [TCMT IO Doc] -> TCMT IO Doc
    forall (m :: * -> *) (t :: * -> *).
    (Applicative m, Foldable t) =>
    t (m Doc) -> m Doc
    sep [[TCMT IO Doc] -> TCMT IO Doc
    forall (m :: * -> *) (t :: * -> *).
    (Applicative m, Semigroup (m Doc), Foldable t) =>
    t (m Doc) -> m Doc
    prettyList ([TCMT IO Doc] -> TCMT IO Doc) -> [TCMT IO Doc] -> TCMT IO Doc
    forall a b. (a -> b) -> a -> b
    $ (Elim' Term -> TCMT IO Doc) -> Elims -> [TCMT IO Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map Elim' Term -> TCMT IO Doc
    forall (m :: * -> *) a. (Applicative m, Pretty a) => a -> m Doc
    pretty Elims
    as, Level -> TCMT IO Doc
    forall (m :: * -> *) a. (Applicative m, Pretty a) => a -> m Doc
    pretty Level
    b]
              Type
    lvl <- m Type
    forall (m :: * -> *). HasBuiltins m => m Type
    levelType
              CompareDirection
    -> MetaId
    -> Elims
    -> Term
    -> CompareAs
    -> (Term -> Term -> m ())
    -> m ()
    forall (m :: * -> *).
    MonadConversion m =>
    CompareDirection
    -> MetaId
    -> Elims
    -> Term
    -> CompareAs
    -> (Term -> Term -> m ())
    -> m ()
    assignE CompareDirection
    DirEq MetaId
    x Elims
    as (Level -> Term
    levelTm Level
    b) (Type -> CompareAs
    AsTermsOf Type
    lvl) Term -> Term -> m ()
    forall {m :: * -> *}.
    (MonadMetaSolver m, MonadWarning m, MonadStatistics m,
     MonadFresh ProblemId m, MonadFresh Int m) =>
    Term -> Term -> m ()
    (===) -- fallback: check equality as atoms

            isNeutral :: SingleLevel' (Blocked' t a) -> Bool
    isNeutral (SinglePlus (Plus Integer
    _ NotBlocked{})) = Bool
    True
            isNeutral SingleLevel' (Blocked' t a)
    _                                  = Bool
    False

            isNeutralOrClosed :: SingleLevel' (Blocked' t a) -> Bool
    isNeutralOrClosed (SingleClosed Integer
    _)                   = Bool
    True
            isNeutralOrClosed (SinglePlus (Plus Integer
    _ NotBlocked{})) = Bool
    True
            isNeutralOrClosed SingleLevel' (Blocked' t a)
    _                                  = Bool
    False

            hasMeta :: SingleLevel' (Blocked' t a) -> Bool
    hasMeta (SinglePlus (Plus Integer
    _ Blocked{})) = Bool
    True
            hasMeta (SinglePlus (Plus Integer
    _ Blocked' t a
    a))         = Maybe MetaId -> Bool
    forall a. Maybe a -> Bool
    isJust (Maybe MetaId -> Bool) -> Maybe MetaId -> Bool
    forall a b. (a -> b) -> a -> b
    $ a -> Maybe MetaId
    forall a. AllMetas a => a -> Maybe MetaId
    firstMeta (a -> Maybe MetaId) -> a -> Maybe MetaId
    forall a b. (a -> b) -> a -> b
    $ Blocked' t a -> a
    forall t a. Blocked' t a -> a
    ignoreBlocking Blocked' t a
    a
            hasMeta (SingleClosed Integer
    _)                = Bool
    False

            removeSubsumed :: Level -> Level -> (Level, Level)
    removeSubsumed Level
    a Level
    b =
              let as :: [SingleLevel' Term]
    as = NonEmpty (SingleLevel' Term) -> [SingleLevel' Term]
    forall a. NonEmpty a -> [a]
    List1.toList (NonEmpty (SingleLevel' Term) -> [SingleLevel' Term])
    -> NonEmpty (SingleLevel' Term) -> [SingleLevel' Term]
    forall a b. (a -> b) -> a -> b
    $ Level -> NonEmpty (SingleLevel' Term)
    forall t. Level' t -> NonEmpty (SingleLevel' t)
    levelMaxView Level
    a
                  bs :: [SingleLevel' Term]
    bs = NonEmpty (SingleLevel' Term) -> [SingleLevel' Term]
    forall a. NonEmpty a -> [a]
    List1.toList (NonEmpty (SingleLevel' Term) -> [SingleLevel' Term])
    -> NonEmpty (SingleLevel' Term) -> [SingleLevel' Term]
    forall a b. (a -> b) -> a -> b
    $ Level -> NonEmpty (SingleLevel' Term)
    forall t. Level' t -> NonEmpty (SingleLevel' t)
    levelMaxView Level
    b
                  a' :: Level
    a' = [SingleLevel' Term] -> Level
    unSingleLevels ([SingleLevel' Term] -> Level) -> [SingleLevel' Term] -> Level
    forall a b. (a -> b) -> a -> b
    $ (SingleLevel' Term -> Bool)
    -> [SingleLevel' Term] -> [SingleLevel' Term]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Bool -> Bool
    not (Bool -> Bool)
    -> (SingleLevel' Term -> Bool) -> SingleLevel' Term -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (SingleLevel' Term -> [SingleLevel' Term] -> Bool
    forall {t :: * -> *} {a}.
    (Foldable t, Eq a) =>
    SingleLevel' a -> t (SingleLevel' a) -> Bool
    `isStrictlySubsumedBy` [SingleLevel' Term]
    bs)) [SingleLevel' Term]
    as
                  b' :: Level
    b' = [SingleLevel' Term] -> Level
    unSingleLevels ([SingleLevel' Term] -> Level) -> [SingleLevel' Term] -> Level
    forall a b. (a -> b) -> a -> b
    $ (SingleLevel' Term -> Bool)
    -> [SingleLevel' Term] -> [SingleLevel' Term]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Bool -> Bool
    not (Bool -> Bool)
    -> (SingleLevel' Term -> Bool) -> SingleLevel' Term -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (SingleLevel' Term -> [SingleLevel' Term] -> Bool
    forall {t :: * -> *} {a}.
    (Foldable t, Eq a) =>
    SingleLevel' a -> t (SingleLevel' a) -> Bool
    `isStrictlySubsumedBy` [SingleLevel' Term]
    as)) [SingleLevel' Term]
    bs
              in (Level
    a',Level
    b')

            SingleLevel' a
    x isStrictlySubsumedBy :: SingleLevel' a -> t (SingleLevel' a) -> Bool
    `isStrictlySubsumedBy` t (SingleLevel' a)
    ys = (SingleLevel' a -> Bool) -> t (SingleLevel' a) -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any (SingleLevel' a -> SingleLevel' a -> Bool
    forall {a}. Eq a => SingleLevel' a -> SingleLevel' a -> Bool
    `strictlySubsumes` SingleLevel' a
    x) t (SingleLevel' a)
    ys

            SingleClosed Integer
    m        strictlySubsumes :: SingleLevel' a -> SingleLevel' a -> Bool
    `strictlySubsumes` SingleClosed Integer
    n        = Integer
    m Integer -> Integer -> Bool
    forall a. Ord a => a -> a -> Bool
    > Integer
    n
            SinglePlus (Plus Integer
    m a
    a) `strictlySubsumes` SingleClosed Integer
    n        = Integer
    m Integer -> Integer -> Bool
    forall a. Ord a => a -> a -> Bool
    > Integer
    n
            SinglePlus (Plus Integer
    m a
    a) `strictlySubsumes` SinglePlus (Plus Integer
    n a
    b) = a
    a a -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    == a
    b Bool -> Bool -> Bool
    && Integer
    m Integer -> Integer -> Bool
    forall a. Ord a => a -> a -> Bool
    > Integer
    n
            SingleLevel' a
    _                     `strictlySubsumes` SingleLevel' a
    _                     = Bool
    False

    -- | Check that the first sort equal to the second.
    equalSort :: forall m. MonadConversion m => Sort -> Sort -> m ()
    equalSort :: forall (m :: * -> *). MonadConversion m => Sort -> Sort -> m ()
    equalSort Sort
    s1 Sort
    s2 = do
        Constraint -> m () -> m ()
    forall (m :: * -> *).
    MonadConstraint m =>
    Constraint -> m () -> m ()
    catchConstraint (Comparison -> Sort -> Sort -> Constraint
    SortCmp Comparison
    CmpEq Sort
    s1 Sort
    s2) (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $ do
            (Sort
    s1,Sort
    s2) <- (Sort, Sort) -> m (Sort, Sort)
    forall a (m :: * -> *). (Reduce a, MonadReduce m) => a -> m a
    reduce (Sort
    s1,Sort
    s2)
            let yes :: m ()
    yes      = () -> m ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
                no :: m ()
    no       = TypeError -> m ()
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCError m) =>
    TypeError -> m a
    typeError (TypeError -> m ()) -> TypeError -> m ()
    forall a b. (a -> b) -> a -> b
    $ Sort -> Sort -> TypeError
    UnequalSorts Sort
    s1 Sort
    s2

            VerboseKey -> Int -> TCMT IO Doc -> m ()
    forall (m :: * -> *).
    MonadDebug m =>
    VerboseKey -> Int -> TCMT IO Doc -> m ()
    reportSDoc VerboseKey
    "tc.conv.sort" Int
    30 (TCMT IO Doc -> m ()) -> TCMT IO Doc -> m ()
    forall a b. (a -> b) -> a -> b
    $ [TCMT IO Doc] -> TCMT IO Doc
    forall (m :: * -> *) (t :: * -> *).
    (Applicative m, Foldable t) =>
    t (m Doc) -> m Doc
    sep
              [ TCMT IO Doc
    "equalSort"
              , [TCMT IO Doc] -> TCMT IO Doc
    forall (m :: * -> *) (t :: * -> *).
    (Applicative m, Foldable t) =>
    t (m Doc) -> m Doc
    vcat [ Int -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Functor m => Int -> m Doc -> m Doc
    nest Int
    2 (TCMT IO Doc -> TCMT IO Doc) -> TCMT IO Doc -> TCMT IO Doc
    forall a b. (a -> b) -> a -> b
    $ [TCMT IO Doc] -> TCMT IO Doc
    forall (m :: * -> *) (t :: * -> *).
    (Applicative m, Foldable t) =>
    t (m Doc) -> m Doc
    fsep [ Sort -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM Sort
    s1 TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> TCMT IO Doc
    "=="
                                     , Sort -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM Sort
    s2 ]
                     , Int -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Functor m => Int -> m Doc -> m Doc
    nest Int
    2 (TCMT IO Doc -> TCMT IO Doc) -> TCMT IO Doc -> TCMT IO Doc
    forall a b. (a -> b) -> a -> b
    $ [TCMT IO Doc] -> TCMT IO Doc
    forall (m :: * -> *) (t :: * -> *).
    (Applicative m, Foldable t) =>
    t (m Doc) -> m Doc
    fsep [ Sort -> TCMT IO Doc
    forall (m :: * -> *) a. (Applicative m, Pretty a) => a -> m Doc
    pretty Sort
    s1 TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> TCMT IO Doc
    "=="
                                     , Sort -> TCMT IO Doc
    forall (m :: * -> *) a. (Applicative m, Pretty a) => a -> m Doc
    pretty Sort
    s2 ]
                     ]
              ]

            Bool
    propEnabled <- m Bool
    forall (m :: * -> *). HasOptions m => m Bool
    isPropEnabled
            Bool
    typeInTypeEnabled <- m Bool
    forall (m :: * -> *). HasOptions m => m Bool
    typeInType
            Bool
    omegaInOmegaEnabled <- PragmaOptions -> Bool
    optOmegaInOmega (PragmaOptions -> Bool) -> m PragmaOptions -> m Bool
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> m PragmaOptions
    forall (m :: * -> *). HasOptions m => m PragmaOptions
    pragmaOptions

            case (Sort
    s1, Sort
    s2) of

                -- Andreas, 2018-09-03: crash on dummy sort
                (DummyS VerboseKey
    s, Sort
    _) -> VerboseKey -> m ()
    forall {m :: * -> *} {a} {b}.
    (ReportS [a], MonadDebug m, IsString a) =>
    a -> m b
    impossibleSort VerboseKey
    s
                (Sort
    _, DummyS VerboseKey
    s) -> VerboseKey -> m ()
    forall {m :: * -> *} {a} {b}.
    (ReportS [a], MonadDebug m, IsString a) =>
    a -> m b
    impossibleSort VerboseKey
    s

                -- one side is a meta sort: try to instantiate
                -- In case both sides are meta sorts, instantiate the
                -- bigger (i.e. more recent) one.
                (MetaS MetaId
    x Elims
    es , MetaS MetaId
    y Elims
    es')
                  | MetaId
    x MetaId -> MetaId -> Bool
    forall a. Eq a => a -> a -> Bool
    == MetaId
    y                 -> Sort -> Sort -> m ()
    synEq Sort
    s1 Sort
    s2
                  | MetaId
    x MetaId -> MetaId -> Bool
    forall a. Ord a => a -> a -> Bool
    < MetaId
    y                  -> MetaId -> Elims -> Sort -> m ()
    meta MetaId
    y Elims
    es' Sort
    s1
                  | Bool
    otherwise              -> MetaId -> Elims -> Sort -> m ()
    meta MetaId
    x Elims
    es Sort
    s2
                (MetaS MetaId
    x Elims
    es , Sort
    _          ) -> MetaId -> Elims -> Sort -> m ()
    meta MetaId
    x Elims
    es Sort
    s2
                (Sort
    _          , MetaS MetaId
    x Elims
    es ) -> MetaId -> Elims -> Sort -> m ()
    meta MetaId
    x Elims
    es Sort
    s1

                -- diagonal cases for rigid sorts
                (Type Level
    a     , Type Level
    b     ) -> Level -> Level -> m ()
    forall (m :: * -> *). MonadConversion m => Level -> Level -> m ()
    equalLevel Level
    a Level
    b m () -> m () -> m ()
    forall {m :: * -> *} {a}. MonadError TCErr m => m a -> m a -> m a
    `catchInequalLevel` m ()
    no
                (Sort
    SizeUniv   , Sort
    SizeUniv   ) -> m ()
    yes
                (Sort
    LockUniv   , Sort
    LockUniv   ) -> m ()
    yes
                (Prop Level
    a     , Prop Level
    b     ) -> Level -> Level -> m ()
    forall (m :: * -> *). MonadConversion m => Level -> Level -> m ()
    equalLevel Level
    a Level
    b m () -> m () -> m ()
    forall {m :: * -> *} {a}. MonadError TCErr m => m a -> m a -> m a
    `catchInequalLevel` m ()
    no
                (Inf IsFibrant
    f Integer
    m    , Inf IsFibrant
    f' Integer
    n   ) ->
                  if IsFibrant
    f IsFibrant -> IsFibrant -> Bool
    forall a. Eq a => a -> a -> Bool
    == IsFibrant
    f' Bool -> Bool -> Bool
    && (Integer
    m Integer -> Integer -> Bool
    forall a. Eq a => a -> a -> Bool
    == Integer
    n Bool -> Bool -> Bool
    || Bool
    typeInTypeEnabled Bool -> Bool -> Bool
    || Bool
    omegaInOmegaEnabled) then m ()
    yes else m ()
    no
                (SSet Level
    a     , SSet Level
    b     ) -> Level -> Level -> m ()
    forall (m :: * -> *). MonadConversion m => Level -> Level -> m ()
    equalLevel Level
    a Level
    b

                -- if --type-in-type is enabled, Setωᵢ is equal to any Set ℓ (see #3439)
                (Type{}     , Inf{}      )
                  | Bool
    typeInTypeEnabled      -> m ()
    yes
                (Inf{}      , Type{}     )
                  | Bool
    typeInTypeEnabled      -> m ()
    yes

                -- equating @PiSort a b@ to another sort
                (Sort
    s1 , PiSort Dom' Term Term
    a Sort
    b Abs Sort
    c) -> Sort -> Dom' Term Term -> Sort -> Abs Sort -> m ()
    piSortEquals Sort
    s1 Dom' Term Term
    a Sort
    b Abs Sort
    c
                (PiSort Dom' Term Term
    a Sort
    b Abs Sort
    c , Sort
    s2) -> Sort -> Dom' Term Term -> Sort -> Abs Sort -> m ()
    piSortEquals Sort
    s2 Dom' Term Term
    a Sort
    b Abs Sort
    c

                -- equating @FunSort a b@ to another sort
                (Sort
    s1 , FunSort Sort
    a Sort
    b) -> Sort -> Sort -> Sort -> m ()
    funSortEquals Sort
    s1 Sort
    a Sort
    b
                (FunSort Sort
    a Sort
    b , Sort
    s2) -> Sort -> Sort -> Sort -> m ()
    funSortEquals Sort
    s2 Sort
    a Sort
    b

                -- equating @UnivSort s@ to another sort
                (Sort
    s1          , UnivSort Sort
    s2) -> Sort -> Sort -> m ()
    univSortEquals Sort
    s1 Sort
    s2
                (UnivSort Sort
    s1 , Sort
    s2         ) -> Sort -> Sort -> m ()
    univSortEquals Sort
    s2 Sort
    s1

                -- postulated sorts can only be equal if they have the same head
                (DefS QName
    d Elims
    es  , DefS QName
    d' Elims
    es')
                  | QName
    d QName -> QName -> Bool
    forall a. Eq a => a -> a -> Bool
    == QName
    d'                -> Sort -> Sort -> m ()
    synEq Sort
    s1 Sort
    s2
                  | Bool
    otherwise              -> m ()
    no

                -- any other combinations of sorts are not equal
                (Sort
    _          , Sort
    _          ) -> m ()
    no

        where
          -- perform assignment (MetaS x es) := s
          meta :: MetaId -> [Elim' Term] -> Sort -> m ()
          meta :: MetaId -> Elims -> Sort -> m ()
    meta MetaId
    x Elims
    es Sort
    s = do
            VerboseKey -> Int -> VerboseKey -> m ()
    forall (m :: * -> *).
    MonadDebug m =>
    VerboseKey -> Int -> VerboseKey -> m ()
    reportSLn VerboseKey
    "tc.meta.sort" Int
    30 (VerboseKey -> m ()) -> VerboseKey -> m ()
    forall a b. (a -> b) -> a -> b
    $ VerboseKey
    "Assigning meta sort"
            VerboseKey -> Int -> TCMT IO Doc -> m ()
    forall (m :: * -> *).
    MonadDebug m =>
    VerboseKey -> Int -> TCMT IO Doc -> m ()
    reportSDoc VerboseKey
    "tc.meta.sort" Int
    50 (TCMT IO Doc -> m ()) -> TCMT IO Doc -> m ()
    forall a b. (a -> b) -> a -> b
    $ TCMT IO Doc
    "meta" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> [TCMT IO Doc] -> TCMT IO Doc
    forall (m :: * -> *) (t :: * -> *).
    (Applicative m, Foldable t) =>
    t (m Doc) -> m Doc
    sep [MetaId -> TCMT IO Doc
    forall (m :: * -> *) a. (Applicative m, Pretty a) => a -> m Doc
    pretty MetaId
    x, [TCMT IO Doc] -> TCMT IO Doc
    forall (m :: * -> *) (t :: * -> *).
    (Applicative m, Semigroup (m Doc), Foldable t) =>
    t (m Doc) -> m Doc
    prettyList ([TCMT IO Doc] -> TCMT IO Doc) -> [TCMT IO Doc] -> TCMT IO Doc
    forall a b. (a -> b) -> a -> b
    $ (Elim' Term -> TCMT IO Doc) -> Elims -> [TCMT IO Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map Elim' Term -> TCMT IO Doc
    forall (m :: * -> *) a. (Applicative m, Pretty a) => a -> m Doc
    pretty Elims
    es, Sort -> TCMT IO Doc
    forall (m :: * -> *) a. (Applicative m, Pretty a) => a -> m Doc
    pretty Sort
    s]
            CompareDirection
    -> MetaId
    -> Elims
    -> Term
    -> CompareAs
    -> (Term -> Term -> m ())
    -> m ()
    forall (m :: * -> *).
    MonadConversion m =>
    CompareDirection
    -> MetaId
    -> Elims
    -> Term
    -> CompareAs
    -> (Term -> Term -> m ())
    -> m ()
    assignE CompareDirection
    DirEq MetaId
    x Elims
    es (Sort -> Term
    Sort Sort
    s) CompareAs
    AsTypes Term -> Term -> m ()
    forall a. HasCallStack => a
    __IMPOSSIBLE__

          -- fall back to syntactic equality check, postpone if it fails
          synEq :: Sort -> Sort -> m ()
          synEq :: Sort -> Sort -> m ()
    synEq Sort
    s1 Sort
    s2 = do
            let postpone :: m ()
    postpone = Blocker -> Constraint -> m ()
    forall (m :: * -> *).
    MonadConstraint m =>
    Blocker -> Constraint -> m ()
    addConstraint ((Sort, Sort) -> Blocker
    forall t. AllMetas t => t -> Blocker
    unblockOnAnyMetaIn (Sort
    s1, Sort
    s2)) (Constraint -> m ()) -> Constraint -> m ()
    forall a b. (a -> b) -> a -> b
    $ Comparison -> Sort -> Sort -> Constraint
    SortCmp Comparison
    CmpEq Sort
    s1 Sort
    s2
            Bool
    doSynEq <- PragmaOptions -> Bool
    optSyntacticEquality (PragmaOptions -> Bool) -> m PragmaOptions -> m Bool
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> m PragmaOptions
    forall (m :: * -> *). HasOptions m => m PragmaOptions
    pragmaOptions
            if | Bool
    doSynEq -> do
                   ((Sort
    s1,Sort
    s2) , Bool
    equal) <- Sort -> Sort -> m ((Sort, Sort), Bool)
    forall a (m :: * -> *).
    (Instantiate a, SynEq a, MonadReduce m) =>
    a -> a -> m ((a, a), Bool)
    SynEq.checkSyntacticEquality Sort
    s1 Sort
    s2
                   if | Bool
    equal     -> () -> m ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
                      | Bool
    otherwise -> m ()
    postpone
               | Bool
    otherwise -> m ()
    postpone

          -- Equate a sort @s1@ to @univSort s2@
          -- Precondition: @s1@ and @univSort s2@ are already reduced.
          univSortEquals :: Sort -> Sort -> m ()
          univSortEquals :: Sort -> Sort -> m ()
    univSortEquals Sort
    s1 Sort
    s2 = do
            VerboseKey -> Int -> TCMT IO Doc -> m ()
    forall (m :: * -> *).
    MonadDebug m =>
    VerboseKey -> Int -> TCMT IO Doc -> m ()
    reportSDoc VerboseKey
    "tc.conv.sort" Int
    35 (TCMT IO Doc -> m ()) -> TCMT IO Doc -> m ()
    forall a b. (a -> b) -> a -> b
    $ [TCMT IO Doc] -> TCMT IO Doc
    forall (m :: * -> *) (t :: * -> *).
    (Applicative m, Foldable t) =>
    t (m Doc) -> m Doc
    vcat
              [ TCMT IO Doc
    "univSortEquals"
              , TCMT IO Doc
    "  s1 =" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> Sort -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM Sort
    s1
              , TCMT IO Doc
    "  s2 =" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> Sort -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM Sort
    s2
              ]
            let no :: m ()
    no = TypeError -> m ()
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCError m) =>
    TypeError -> m a
    typeError (TypeError -> m ()) -> TypeError -> m ()
    forall a b. (a -> b) -> a -> b
    $ Sort -> Sort -> TypeError
    UnequalSorts Sort
    s1 (Sort -> Sort
    forall t. Sort' t -> Sort' t
    UnivSort Sort
    s2)
            case Sort
    s1 of
              -- @Set l1@ is the successor sort of either @Set l2@ or
              -- @Prop l2@ where @l1 == lsuc l2@.
              Type Level
    l1 -> do
                Bool
    propEnabled <- m Bool
    forall (m :: * -> *). HasOptions m => m Bool
    isPropEnabled
                   -- @s2@ is definitely not @Inf n@ or @SizeUniv@
                if | Inf IsFibrant
    _ Integer
    n  <- Sort
    s2 -> m ()
    no
                   | Sort
    SizeUniv <- Sort
    s2 -> m ()
    no
                   -- If @Prop@ is not used, then @s2@ must be of the form
                   -- @Set l2@
                   | Bool -> Bool
    not Bool
    propEnabled -> do
                       Level
    l2 <- case Integer -> Level -> Maybe Level
    subLevel Integer
    1 Level
    l1 of
                         Just Level
    l2 -> Level -> m Level
    forall (m :: * -> *) a. Monad m => a -> m a
    return Level
    l2
                         Maybe Level
    Nothing -> do
                           Level
    l2 <- m Level
    forall (m :: * -> *). MonadMetaSolver m => m Level
    newLevelMeta
                           Level -> Level -> m ()
    forall (m :: * -> *). MonadConversion m => Level -> Level -> m ()
    equalLevel Level
    l1 (Level -> Level
    levelSuc Level
    l2)
                           Level -> m Level
    forall (m :: * -> *) a. Monad m => a -> m a
    return Level
    l2
                       Sort -> Sort -> m ()
    forall (m :: * -> *). MonadConversion m => Sort -> Sort -> m ()
    equalSort (Level -> Sort
    forall t. Level' t -> Sort' t
    Type Level
    l2) Sort
    s2
                   -- Otherwise we postpone
                   | Bool
    otherwise -> Sort -> Sort -> m ()
    synEq (Level -> Sort
    forall t. Level' t -> Sort' t
    Type Level
    l1) (Sort -> Sort
    forall t. Sort' t -> Sort' t
    UnivSort Sort
    s2)
              -- @Setωᵢ@ is a successor sort if n > 0, or if
              -- --type-in-type or --omega-in-omega is enabled.
              Inf IsFibrant
    f Integer
    n | Integer
    n Integer -> Integer -> Bool
    forall a. Ord a => a -> a -> Bool
    > Integer
    0 -> Sort -> Sort -> m ()
    forall (m :: * -> *). MonadConversion m => Sort -> Sort -> m ()
    equalSort (IsFibrant -> Integer -> Sort
    forall t. IsFibrant -> Integer -> Sort' t
    Inf IsFibrant
    f (Integer -> Sort) -> Integer -> Sort
    forall a b. (a -> b) -> a -> b
    $ Integer
    n Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    - Integer
    1) Sort
    s2
              Inf IsFibrant
    f Integer
    0 -> do
                Bool
    infInInf <- (PragmaOptions -> Bool
    optOmegaInOmega (PragmaOptions -> Bool) -> m PragmaOptions -> m Bool
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> m PragmaOptions
    forall (m :: * -> *). HasOptions m => m PragmaOptions
    pragmaOptions) m Bool -> m Bool -> m Bool
    forall (m :: * -> *). Monad m => m Bool -> m Bool -> m Bool
    `or2M` m Bool
    forall (m :: * -> *). HasOptions m => m Bool
    typeInType
                if | Bool
    infInInf  -> Sort -> Sort -> m ()
    forall (m :: * -> *). MonadConversion m => Sort -> Sort -> m ()
    equalSort (IsFibrant -> Integer -> Sort
    forall t. IsFibrant -> Integer -> Sort' t
    Inf IsFibrant
    f Integer
    0) Sort
    s2
                   | Bool
    otherwise -> m ()
    no
              -- @Prop l@ and @SizeUniv@ are not successor sorts
              Prop{}     -> m ()
    no
              SizeUniv{} -> m ()
    no
              -- Anything else: postpone
              Sort
    _          -> Sort -> Sort -> m ()
    synEq Sort
    s1 (Sort -> Sort
    forall t. Sort' t -> Sort' t
    UnivSort Sort
    s2)

          -- Equate a sort @s@ to @piSort a s1 s2@
          -- Precondition: @s@ and @piSort a s1 s2@ are already reduced.
          piSortEquals :: Sort -> Dom Term -> Sort -> Abs Sort -> m ()
          piSortEquals :: Sort -> Dom' Term Term -> Sort -> Abs Sort -> m ()
    piSortEquals Sort
    s Dom' Term Term
    a Sort
    s1 NoAbs{} = m ()
    forall a. HasCallStack => a
    __IMPOSSIBLE__
          piSortEquals Sort
    s Dom' Term Term
    a Sort
    s1 s2Abs :: Abs Sort
    s2Abs@(Abs VerboseKey
    x Sort
    s2) = do
            let adom :: Dom Type
    adom = Sort -> Term -> Type
    forall t a. Sort' t -> a -> Type'' t a
    El Sort
    s1 (Term -> Type) -> Dom' Term Term -> Dom Type
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Dom' Term Term
    a
            VerboseKey -> Int -> TCMT IO Doc -> m ()
    forall (m :: * -> *).
    MonadDebug m =>
    VerboseKey -> Int -> TCMT IO Doc -> m ()
    reportSDoc VerboseKey
    "tc.conv.sort" Int
    35 (TCMT IO Doc -> m ()) -> TCMT IO Doc -> m ()
    forall a b. (a -> b) -> a -> b
    $ [TCMT IO Doc] -> TCMT IO Doc
    forall (m :: * -> *) (t :: * -> *).
    (Applicative m, Foldable t) =>
    t (m Doc) -> m Doc
    vcat
              [ TCMT IO Doc
    "piSortEquals"
              , TCMT IO Doc
    "  s  =" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> Sort -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM Sort
    s
              , TCMT IO Doc
    "  a  =" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> Dom Type -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM Dom Type
    adom
              , TCMT IO Doc
    "  s1 =" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> Sort -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM Sort
    s1
              , TCMT IO Doc
    "  s2 =" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> (VerboseKey, Dom Type) -> TCMT IO Doc -> TCMT IO Doc
    forall b (m :: * -> *) a.
    (AddContext b, MonadAddContext m) =>
    b -> m a -> m a
    addContext (VerboseKey
    x,Dom Type
    adom) (Sort -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM Sort
    s2)
              ]
            Bool
    propEnabled <- m Bool
    forall (m :: * -> *). HasOptions m => m Bool
    isPropEnabled
               -- If @s2@ is dependent, then @piSort a s1 s2@ computes to
               -- @Setωi@. Hence, if @s@ is small, then @s2@
               -- cannot be dependent.
            if | Just (Bool
    True,IsFibrant
    _) <- Sort -> Maybe (Bool, IsFibrant)
    isSmallSort Sort
    s -> do
                   -- We force @s2@ to be non-dependent by unifying it with
                   -- a fresh meta that does not depend on @x : a@
                   Sort
    s2' <- m Sort
    forall (m :: * -> *). MonadMetaSolver m => m Sort
    newSortMeta
                   (VerboseKey, Dom Type) -> m () -> m ()
    forall b (m :: * -> *) a.
    (AddContext b, MonadAddContext m) =>
    b -> m a -> m a
    addContext (VerboseKey
    x , Dom Type
    adom) (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $ Sort -> Sort -> m ()
    forall (m :: * -> *). MonadConversion m => Sort -> Sort -> m ()
    equalSort Sort
    s2 (Int -> Sort -> Sort
    forall a. Subst a => Int -> a -> a
    raise Int
    1 Sort
    s2')
                   Sort -> Sort -> Sort -> m ()
    funSortEquals Sort
    s Sort
    s1 Sort
    s2'
               -- Otherwise: postpone
               | Bool
    otherwise                  -> Sort -> Sort -> m ()
    synEq (Dom' Term Term -> Sort -> Abs Sort -> Sort
    forall t. Dom' t t -> Sort' t -> Abs (Sort' t) -> Sort' t
    PiSort Dom' Term Term
    a Sort
    s1 Abs Sort
    s2Abs) Sort
    s

          -- Equate a sort @s@ to @funSort s1 s2@
          -- Precondition: @s@ and @funSort s1 s2@ are already reduced
          funSortEquals :: Sort -> Sort -> Sort -> m ()
          funSortEquals :: Sort -> Sort -> Sort -> m ()
    funSortEquals Sort
    s0 Sort
    s1 Sort
    s2 = do
            VerboseKey -> Int -> TCMT IO Doc -> m ()
    forall (m :: * -> *).
    MonadDebug m =>
    VerboseKey -> Int -> TCMT IO Doc -> m ()
    reportSDoc VerboseKey
    "tc.conv.sort" Int
    35 (TCMT IO Doc -> m ()) -> TCMT IO Doc -> m ()
    forall a b. (a -> b) -> a -> b
    $ [TCMT IO Doc] -> TCMT IO Doc
    forall (m :: * -> *) (t :: * -> *).
    (Applicative m, Foldable t) =>
    t (m Doc) -> m Doc
    vcat
              [ TCMT IO Doc
    "funSortEquals"
              , TCMT IO Doc
    "  s0 =" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> Sort -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM Sort
    s0
              , TCMT IO Doc
    "  s1 =" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> Sort -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM Sort
    s1
              , TCMT IO Doc
    "  s2 =" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> Sort -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM Sort
    s2
              ]
            Bool
    propEnabled <- m Bool
    forall (m :: * -> *). HasOptions m => m Bool
    isPropEnabled
            Bool
    sizedTypesEnabled <- m Bool
    forall (m :: * -> *). HasOptions m => m Bool
    sizedTypesOption
            case Sort
    s0 of
              -- If @Setωᵢ == funSort s1 s2@, then either @s1@ or @s2@ must
              -- be @Setωᵢ@.
              Inf IsFibrant
    f Integer
    n | Just (Bool
    True,IsFibrant
    _) <- Sort -> Maybe (Bool, IsFibrant)
    isSmallSort Sort
    s1, Just (Bool
    True,IsFibrant
    _) <- Sort -> Maybe (Bool, IsFibrant)
    isSmallSort Sort
    s2 -> do
                        TypeError -> m ()
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCError m) =>
    TypeError -> m a
    typeError (TypeError -> m ()) -> TypeError -> m ()
    forall a b. (a -> b) -> a -> b
    $ Sort -> Sort -> TypeError
    UnequalSorts Sort
    s0 (Sort -> Sort -> Sort
    forall t. Sort' t -> Sort' t -> Sort' t
    FunSort Sort
    s1 Sort
    s2)
                      | Just (Bool
    True, IsFibrant
    IsFibrant) <- Sort -> Maybe (Bool, IsFibrant)
    isSmallSort Sort
    s1 -> Sort -> Sort -> m ()
    forall (m :: * -> *). MonadConversion m => Sort -> Sort -> m ()
    equalSort (IsFibrant -> Integer -> Sort
    forall t. IsFibrant -> Integer -> Sort' t
    Inf IsFibrant
    f Integer
    n) Sort
    s2
                      | Just (Bool
    True, IsFibrant
    IsFibrant) <- Sort -> Maybe (Bool, IsFibrant)
    isSmallSort Sort
    s2 -> Sort -> Sort -> m ()
    forall (m :: * -> *). MonadConversion m => Sort -> Sort -> m ()
    equalSort (IsFibrant -> Integer -> Sort
    forall t. IsFibrant -> Integer -> Sort' t
    Inf IsFibrant
    f Integer
    n) Sort
    s1
                      -- TODO 2ltt: handle IsStrict cases.
                      | Bool
    otherwise                   -> Sort -> Sort -> m ()
    synEq Sort
    s0 (Sort -> Sort -> Sort
    forall t. Sort' t -> Sort' t -> Sort' t
    FunSort Sort
    s1 Sort
    s2)
              -- If @Set l == funSort s1 s2@, then @s2@ must be of the
              -- form @Set l2@. @s1@ can be one of @Set l1@, @Prop l1@, or
              -- @SizeUniv@.
              Type Level
    l -> do
                Level
    l2 <- Sort -> m Level
    forceType Sort
    s2
                -- We must have @l2 =< l@, this might help us to solve
                -- more constraints (in particular when @l == 0@).
                Level -> Level -> m ()
    forall (m :: * -> *). MonadConversion m => Level -> Level -> m ()
    leqLevel Level
    l2 Level
    l
                -- Jesper, 2019-12-27: SizeUniv is disabled at the moment.
                if | {- sizedTypesEnabled || -} Bool
    propEnabled -> case Sort -> Sort -> Maybe Sort
    funSort' Sort
    s1 (Level -> Sort
    forall t. Level' t -> Sort' t
    Type Level
    l2) of
                       -- If the work we did makes the @funSort@ compute,
                       -- continue working.
                       Just Sort
    s  -> Sort -> Sort -> m ()
    forall (m :: * -> *). MonadConversion m => Sort -> Sort -> m ()
    equalSort (Level -> Sort
    forall t. Level' t -> Sort' t
    Type Level
    l) Sort
    s
                       -- Otherwise: postpone
                       Maybe Sort
    Nothing -> Sort -> Sort -> m ()
    synEq (Level -> Sort
    forall t. Level' t -> Sort' t
    Type Level
    l) (Sort -> Sort -> Sort
    forall t. Sort' t -> Sort' t -> Sort' t
    FunSort Sort
    s1 (Sort -> Sort) -> Sort -> Sort
    forall a b. (a -> b) -> a -> b
    $ Level -> Sort
    forall t. Level' t -> Sort' t
    Type Level
    l2)
                   -- If both Prop and sized types are disabled, only the
                   -- case @s1 == Set l1@ remains.
                   | Bool
    otherwise -> do
                       Level
    l1 <- Sort -> m Level
    forceType Sort
    s1
                       Level -> Level -> m ()
    forall (m :: * -> *). MonadConversion m => Level -> Level -> m ()
    equalLevel Level
    l (Level -> Level -> Level
    levelLub Level
    l1 Level
    l2)
              -- If @Prop l == funSort s1 s2@, then @s2@ must be of the
              -- form @Prop l2@, and @s1@ can be one of @Set l1@, Prop
              -- l1@, or @SizeUniv@.
              Prop Level
    l -> do
                Level
    l2 <- Sort -> m Level
    forceProp Sort
    s2
                Level -> Level -> m ()
    forall (m :: * -> *). MonadConversion m => Level -> Level -> m ()
    leqLevel Level
    l2 Level
    l
                case Sort -> Sort -> Maybe Sort
    funSort' Sort
    s1 (Level -> Sort
    forall t. Level' t -> Sort' t
    Prop Level
    l2) of
                       -- If the work we did makes the @funSort@ compute,
                       -- continue working.
                       Just Sort
    s  -> Sort -> Sort -> m ()
    forall (m :: * -> *). MonadConversion m => Sort -> Sort -> m ()
    equalSort (Level -> Sort
    forall t. Level' t -> Sort' t
    Prop Level
    l) Sort
    s
                       -- Otherwise: postpone
                       Maybe Sort
    Nothing -> Sort -> Sort -> m ()
    synEq (Level -> Sort
    forall t. Level' t -> Sort' t
    Prop Level
    l) (Sort -> Sort -> Sort
    forall t. Sort' t -> Sort' t -> Sort' t
    FunSort Sort
    s1 (Sort -> Sort) -> Sort -> Sort
    forall a b. (a -> b) -> a -> b
    $ Level -> Sort
    forall t. Level' t -> Sort' t
    Prop Level
    l2)
              -- We have @SizeUniv == funSort s1 s2@ iff @s2 == SizeUniv@
              Sort
    SizeUniv -> Sort -> Sort -> m ()
    forall (m :: * -> *). MonadConversion m => Sort -> Sort -> m ()
    equalSort Sort
    forall t. Sort' t
    SizeUniv Sort
    s2
              -- Anything else: postpone
              Sort
    _        -> Sort -> Sort -> m ()
    synEq Sort
    s0 (Sort -> Sort -> Sort
    forall t. Sort' t -> Sort' t -> Sort' t
    FunSort Sort
    s1 Sort
    s2)

          -- check if the given sort @s0@ is a (closed) bottom sort
          -- i.e. @piSort a b == s0@ implies @b == s0@.
          isBottomSort :: Bool -> Sort -> Bool
          isBottomSort :: Bool -> Sort -> Bool
    isBottomSort Bool
    propEnabled (Prop (ClosedLevel Integer
    0)) = Bool
    True
          isBottomSort Bool
    propEnabled (Type (ClosedLevel Integer
    0)) = Bool -> Bool
    not Bool
    propEnabled
          isBottomSort Bool
    propEnabled Sort
    _                      = Bool
    False
          -- (NB: Defined but not currently used)

          forceType :: Sort -> m Level
          forceType :: Sort -> m Level
    forceType (Type Level
    l) = Level -> m Level
    forall (m :: * -> *) a. Monad m => a -> m a
    return Level
    l
          forceType Sort
    s = do
            Level
    l <- m Level
    forall (m :: * -> *). MonadMetaSolver m => m Level
    newLevelMeta
            Sort -> Sort -> m ()
    forall (m :: * -> *). MonadConversion m => Sort -> Sort -> m ()
    equalSort Sort
    s (Level -> Sort
    forall t. Level' t -> Sort' t
    Type Level
    l)
            Level -> m Level
    forall (m :: * -> *) a. Monad m => a -> m a
    return Level
    l

          forceProp :: Sort -> m Level
          forceProp :: Sort -> m Level
    forceProp (Prop Level
    l) = Level -> m Level
    forall (m :: * -> *) a. Monad m => a -> m a
    return Level
    l
          forceProp Sort
    s = do
            Level
    l <- m Level
    forall (m :: * -> *). MonadMetaSolver m => m Level
    newLevelMeta
            Sort -> Sort -> m ()
    forall (m :: * -> *). MonadConversion m => Sort -> Sort -> m ()
    equalSort Sort
    s (Level -> Sort
    forall t. Level' t -> Sort' t
    Prop Level
    l)
            Level -> m Level
    forall (m :: * -> *) a. Monad m => a -> m a
    return Level
    l

          impossibleSort :: a -> m b
    impossibleSort a
    s = do
            VerboseKey -> Int -> [a] -> m ()
    forall a (m :: * -> *).
    (ReportS a, MonadDebug m) =>
    VerboseKey -> Int -> a -> m ()
    reportS VerboseKey
    "impossible" Int
    10
              [ a
    "equalSort: found dummy sort with description:"
              , a
    s
              ]
            m b
    forall a. HasCallStack => a
    __IMPOSSIBLE__

          catchInequalLevel :: m a -> m a -> m a
    catchInequalLevel m a
    m m a
    fail = m a
    m m a -> (TCErr -> m a) -> m a
    forall e (m :: * -> *) a.
    MonadError e m =>
    m a -> (e -> m a) -> m a
    `catchError` \case
            TypeError{} -> m a
    fail
            TCErr
    err         -> TCErr -> m a
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError TCErr
    err

    -- -- This should probably represent face maps with a more precise type
    -- toFaceMaps :: Term -> TCM [[(Int,Term)]]
    -- toFaceMaps t = do
    --   view <- intervalView'
    --   iz <- primIZero
    --   io <- primIOne
    --   ineg <- (\ q t -> Def q [Apply $ Arg defaultArgInfo t]) <$> fromMaybe __IMPOSSIBLE__ <$> getPrimitiveName' "primINeg"

    --   let f IZero = mzero
    --       f IOne  = return []
    --       f (IMin x y) = do xs <- (f . view . unArg) x; ys <- (f . view . unArg) y; return (xs ++ ys)
    --       f (IMax x y) = msum $ map (f . view . unArg) [x,y]
    --       f (INeg x)   = map (id -*- not) <$> (f . view . unArg) x
    --       f (OTerm (Var i [])) = return [(i,True)]
    --       f (OTerm _) = return [] -- what about metas? we should suspend? maybe no metas is a precondition?
    --       isConsistent xs = all (\ xs -> length xs == 1) . map nub . Map.elems $ xs  -- optimize by not doing generate + filter
    --       as = map (map (id -*- head) . Map.toAscList) . filter isConsistent . map (Map.fromListWith (++) . map (id -*- (:[]))) $ (f (view t))
    --   xs <- mapM (mapM (\ (i,b) -> (,) i <$> intervalUnview (if b then IOne else IZero))) as
    --   return xs

    forallFaceMaps :: MonadConversion m => Term -> (Map.Map Int Bool -> Blocker -> Term -> m a) -> (Substitution -> m a) -> m [a]
    forallFaceMaps :: forall (m :: * -> *) a.
    MonadConversion m =>
    Term
    -> (Map Int Bool -> Blocker -> Term -> m a)
    -> (Substitution -> m a)
    -> m [a]
    forallFaceMaps Term
    t Map Int Bool -> Blocker -> Term -> m a
    kb Substitution -> m a
    k = do
      VerboseKey -> Int -> TCMT IO Doc -> m ()
    forall (m :: * -> *).
    MonadDebug m =>
    VerboseKey -> Int -> TCMT IO Doc -> m ()
    reportSDoc VerboseKey
    "conv.forall" Int
    20 (TCMT IO Doc -> m ()) -> TCMT IO Doc -> m ()
    forall a b. (a -> b) -> a -> b
    $
          [TCMT IO Doc] -> TCMT IO Doc
    forall (m :: * -> *) (t :: * -> *).
    (Applicative m, Foldable t) =>
    t (m Doc) -> m Doc
    fsep [TCMT IO Doc
    "forallFaceMaps"
               , Term -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM Term
    t
               ]
      [(Map Int Bool, [Term])]
    as <- Term -> m [(Map Int Bool, [Term])]
    forall (m :: * -> *).
    HasBuiltins m =>
    Term -> m [(Map Int Bool, [Term])]
    decomposeInterval Term
    t
      Bool -> Term
    boolToI <- do
        Term
    io <- m Term
    forall (m :: * -> *).
    (HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
    m Term
    primIOne
        Term
    iz <- m Term
    forall (m :: * -> *).
    (HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
    m Term
    primIZero
        (Bool -> Term) -> m (Bool -> Term)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (\Bool
    b -> if Bool
    b then Term
    io else Term
    iz)
      [(Map Int Bool, [Term])]
    -> ((Map Int Bool, [Term]) -> m a) -> m [a]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    t a -> (a -> m b) -> m (t b)
    forM [(Map Int Bool, [Term])]
    as (((Map Int Bool, [Term]) -> m a) -> m [a])
    -> ((Map Int Bool, [Term]) -> m a) -> m [a]
    forall a b. (a -> b) -> a -> b
    $ \ (Map Int Bool
    ms,[Term]
    ts) -> do
       [Term]
    -> (Blocker -> Term -> m a) -> (NotBlocked -> Term -> m a) -> m a
    forall {m :: * -> *} {t :: * -> *} {b}.
    (HasBuiltins m, MonadError TCErr m, Foldable t, MonadReduce m) =>
    t Term
    -> (Blocker -> Term -> m b) -> (NotBlocked -> Term -> m b) -> m b
    ifBlockeds [Term]
    ts (Map Int Bool -> Blocker -> Term -> m a
    kb Map Int Bool
    ms) ((NotBlocked -> Term -> m a) -> m a)
    -> (NotBlocked -> Term -> m a) -> m a
    forall a b. (a -> b) -> a -> b
    $ \ NotBlocked
    _ Term
    _ -> do
        let xs :: [(Int, Term)]
    xs = ((Int, Bool) -> (Int, Term)) -> [(Int, Bool)] -> [(Int, Term)]
    forall a b. (a -> b) -> [a] -> [b]
    map ((Bool -> Term) -> (Int, Bool) -> (Int, Term)
    forall (a :: * -> * -> *) b c d.
    Arrow a =>
    a b c -> a (d, b) (d, c)
    second Bool -> Term
    boolToI) ([(Int, Bool)] -> [(Int, Term)]) -> [(Int, Bool)] -> [(Int, Term)]
    forall a b. (a -> b) -> a -> b
    $ Map Int Bool -> [(Int, Bool)]
    forall k a. Map k a -> [(k, a)]
    Map.toAscList Map Int Bool
    ms
        [Dom (Name, Type)]
    cxt <- m [Dom (Name, Type)]
    forall (m :: * -> *). MonadTCEnv m => m [Dom (Name, Type)]
    getContext
        VerboseKey -> Int -> TCMT IO Doc -> m ()
    forall (m :: * -> *).
    MonadDebug m =>
    VerboseKey -> Int -> TCMT IO Doc -> m ()
    reportSDoc VerboseKey
    "conv.forall" Int
    20 (TCMT IO Doc -> m ()) -> TCMT IO Doc -> m ()
    forall a b. (a -> b) -> a -> b
    $
          [TCMT IO Doc] -> TCMT IO Doc
    forall (m :: * -> *) (t :: * -> *).
    (Applicative m, Foldable t) =>
    t (m Doc) -> m Doc
    fsep [TCMT IO Doc
    "substContextN"
               , [Dom (Name, Type)] -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM [Dom (Name, Type)]
    cxt
               , [(Int, Term)] -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM [(Int, Term)]
    xs
               ]
        ([Dom (Name, Type)]
    cxt',Substitution
    sigma) <- [Dom (Name, Type)]
    -> [(Int, Term)] -> m ([Dom (Name, Type)], Substitution)
    forall (m :: * -> *).
    MonadConversion m =>
    [Dom (Name, Type)]
    -> [(Int, Term)] -> m ([Dom (Name, Type)], Substitution)
    substContextN [Dom (Name, Type)]
    cxt [(Int, Term)]
    xs
        [(Dom (Name, Type), Term)]
    resolved <- [(Int, Term)]
    -> ((Int, Term) -> m (Dom (Name, Type), Term))
    -> m [(Dom (Name, Type), Term)]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    t a -> (a -> m b) -> m (t b)
    forM [(Int, Term)]
    xs (\ (Int
    i,Term
    t) -> (,) (Dom (Name, Type) -> Term -> (Dom (Name, Type), Term))
    -> m (Dom (Name, Type)) -> m (Term -> (Dom (Name, Type), Term))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Int -> m (Dom (Name, Type))
    forall (m :: * -> *).
    (MonadFail m, MonadTCEnv m) =>
    Int -> m (Dom (Name, Type))
    lookupBV Int
    i m (Term -> (Dom (Name, Type), Term))
    -> m Term -> m (Dom (Name, Type), Term)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Term -> m Term
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Substitution' (SubstArg Term) -> Term -> Term
    forall a. Subst a => Substitution' (SubstArg a) -> a -> a
    applySubst Substitution
    Substitution' (SubstArg Term)
    sigma Term
    t))
        Substitution
    -> ([Dom (Name, Type)] -> [Dom (Name, Type)]) -> m a -> m a
    forall (m :: * -> *) a.
    MonadAddContext m =>
    Substitution
    -> ([Dom (Name, Type)] -> [Dom (Name, Type)]) -> m a -> m a
    updateContext Substitution
    sigma ([Dom (Name, Type)] -> [Dom (Name, Type)] -> [Dom (Name, Type)]
    forall a b. a -> b -> a
    const [Dom (Name, Type)]
    cxt') (m a -> m a) -> m a -> m a
    forall a b. (a -> b) -> a -> b
    $
          [(Dom (Name, Type), Term)] -> m a -> m a
    forall {m :: * -> *} {t} {a}.
    MonadAddContext m =>
    [(Dom' t (Name, Type), Term)] -> m a -> m a
    addBindings [(Dom (Name, Type), Term)]
    resolved (m a -> m a) -> m a -> m a
    forall a b. (a -> b) -> a -> b
    $ do
            Closure ()
    cl <- () -> m (Closure ())
    forall (m :: * -> *) a.
    (MonadTCEnv m, ReadTCState m) =>
    a -> m (Closure a)
    buildClosure ()
            Telescope
    tel <- m Telescope
    forall (m :: * -> *). (Applicative m, MonadTCEnv m) => m Telescope
    getContextTelescope
            ModuleName
    m <- m ModuleName
    forall (m :: * -> *). MonadTCEnv m => m ModuleName
    currentModule
            Maybe Substitution
    sub <- ModuleName -> m (Maybe Substitution)
    forall (m :: * -> *).
    (MonadTCEnv m, ReadTCState m) =>
    ModuleName -> m (Maybe Substitution)
    getModuleParameterSub ModuleName
    m
            VerboseKey -> Int -> Names -> m ()
    forall a (m :: * -> *).
    (ReportS a, MonadDebug m) =>
    VerboseKey -> Int -> a -> m ()
    reportS VerboseKey
    "conv.forall" Int
    10
              [ Int -> Char -> VerboseKey
    forall a. Int -> a -> [a]
    replicate Int
    10 Char
    '-'
              , ModuleName -> VerboseKey
    forall a. Show a => a -> VerboseKey
    show (TCEnv -> ModuleName
    envCurrentModule (TCEnv -> ModuleName) -> TCEnv -> ModuleName
    forall a b. (a -> b) -> a -> b
    $ Closure () -> TCEnv
    forall a. Closure a -> TCEnv
    clEnv Closure ()
    cl)
              , LetBindings -> VerboseKey
    forall a. Show a => a -> VerboseKey
    show (TCEnv -> LetBindings
    envLetBindings (TCEnv -> LetBindings) -> TCEnv -> LetBindings
    forall a b. (a -> b) -> a -> b
    $ Closure () -> TCEnv
    forall a. Closure a -> TCEnv
    clEnv Closure ()
    cl)
              , Telescope -> VerboseKey
    forall a. Show a => a -> VerboseKey
    show Telescope
    tel -- (toTelescope $ envContext $ clEnv cl)
              , Substitution -> VerboseKey
    forall a. Show a => a -> VerboseKey
    show Substitution
    sigma
              , ModuleName -> VerboseKey
    forall a. Show a => a -> VerboseKey
    show ModuleName
    m
              , Maybe Substitution -> VerboseKey
    forall a. Show a => a -> VerboseKey
    show Maybe Substitution
    sub
              ]
            Substitution -> m a
    k Substitution
    sigma
      where
        -- TODO Andrea: inefficient because we try to reduce the ts which we know are in whnf
        ifBlockeds :: t Term
    -> (Blocker -> Term -> m b) -> (NotBlocked -> Term -> m b) -> m b
    ifBlockeds t Term
    ts Blocker -> Term -> m b
    blocked NotBlocked -> Term -> m b
    unblocked = do
          Term
    and <- VerboseKey -> m Term
    forall (m :: * -> *).
    (HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
    VerboseKey -> m Term
    getPrimitiveTerm VerboseKey
    "primIMin"
          Term
    io  <- m Term
    forall (m :: * -> *).
    (HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
    m Term
    primIOne
          let t :: Term
    t = (Term -> Term -> Term) -> Term -> t Term -> Term
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr (\ Term
    x Term
    r -> Term
    and Term -> [Arg Term] -> Term
    forall t. Apply t => t -> [Arg Term] -> t
    `apply` [Term -> Arg Term
    forall e. e -> Arg e
    argN Term
    x,Term -> Arg Term
    forall e. e -> Arg e
    argN Term
    r]) Term
    io t Term
    ts
          Term
    -> (Blocker -> Term -> m b) -> (NotBlocked -> Term -> m b) -> m b
    forall t (m :: * -> *) a.
    (Reduce t, IsMeta t, MonadReduce m) =>
    t -> (Blocker -> t -> m a) -> (NotBlocked -> t -> m a) -> m a
    ifBlocked Term
    t Blocker -> Term -> m b
    blocked NotBlocked -> Term -> m b
    unblocked
        addBindings :: [(Dom' t (Name, Type), Term)] -> m a -> m a
    addBindings [] m a
    m = m a
    m
        addBindings ((Dom{domInfo :: forall t e. Dom' t e -> ArgInfo
    domInfo = ArgInfo
    info,unDom :: forall t e. Dom' t e -> e
    unDom = (Name
    nm,Type
    ty)},Term
    t):[(Dom' t (Name, Type), Term)]
    bs) m a
    m = ArgInfo -> Name -> Term -> Type -> m a -> m a
    forall (m :: * -> *) a.
    MonadAddContext m =>
    ArgInfo -> Name -> Term -> Type -> m a -> m a
    addLetBinding ArgInfo
    info Name
    nm Term
    t Type
    ty ([(Dom' t (Name, Type), Term)] -> m a -> m a
    addBindings [(Dom' t (Name, Type), Term)]
    bs m a
    m)

        substContextN :: MonadConversion m => Context -> [(Int,Term)] -> m (Context , Substitution)
        substContextN :: forall (m :: * -> *).
    MonadConversion m =>
    [Dom (Name, Type)]
    -> [(Int, Term)] -> m ([Dom (Name, Type)], Substitution)
    substContextN [Dom (Name, Type)]
    c [] = ([Dom (Name, Type)], Substitution)
    -> m ([Dom (Name, Type)], Substitution)
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([Dom (Name, Type)]
    c, Substitution
    forall a. Substitution' a
    idS)
        substContextN [Dom (Name, Type)]
    c ((Int
    i,Term
    t):[(Int, Term)]
    xs) = do
          ([Dom (Name, Type)]
    c', Substitution
    sigma) <- Int
    -> Term
    -> [Dom (Name, Type)]
    -> m ([Dom (Name, Type)], Substitution)
    forall (m :: * -> *).
    MonadConversion m =>
    Int
    -> Term
    -> [Dom (Name, Type)]
    -> m ([Dom (Name, Type)], Substitution)
    substContext Int
    i Term
    t [Dom (Name, Type)]
    c
          ([Dom (Name, Type)]
    c'', Substitution
    sigma')  <- [Dom (Name, Type)]
    -> [(Int, Term)] -> m ([Dom (Name, Type)], Substitution)
    forall (m :: * -> *).
    MonadConversion m =>
    [Dom (Name, Type)]
    -> [(Int, Term)] -> m ([Dom (Name, Type)], Substitution)
    substContextN [Dom (Name, Type)]
    c' (((Int, Term) -> (Int, Term)) -> [(Int, Term)] -> [(Int, Term)]
    forall a b. (a -> b) -> [a] -> [b]
    map (Int -> Int -> Int
    forall a. Num a => a -> a -> a
    subtract Int
    1 (Int -> Int) -> (Term -> Term) -> (Int, Term) -> (Int, Term)
    forall a c b d. (a -> c) -> (b -> d) -> (a, b) -> (c, d)
    -*- Substitution' (SubstArg Term) -> Term -> Term
    forall a. Subst a => Substitution' (SubstArg a) -> a -> a
    applySubst Substitution
    Substitution' (SubstArg Term)
    sigma) [(Int, Term)]
    xs)
          ([Dom (Name, Type)], Substitution)
    -> m ([Dom (Name, Type)], Substitution)
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([Dom (Name, Type)]
    c'', Substitution' (SubstArg Substitution)
    -> Substitution -> Substitution
    forall a. Subst a => Substitution' (SubstArg a) -> a -> a
    applySubst Substitution
    Substitution' (SubstArg Substitution)
    sigma' Substitution
    sigma)

        -- assumes the term can be typed in the shorter telescope
        -- the terms we get from toFaceMaps are closed.
        substContext :: MonadConversion m => Int -> Term -> Context -> m (Context , Substitution)
        substContext :: forall (m :: * -> *).
    MonadConversion m =>
    Int
    -> Term
    -> [Dom (Name, Type)]
    -> m ([Dom (Name, Type)], Substitution)
    substContext Int
    i Term
    t [] = m ([Dom (Name, Type)], Substitution)
    forall a. HasCallStack => a
    __IMPOSSIBLE__
        substContext Int
    i Term
    t (Dom (Name, Type)
    x:[Dom (Name, Type)]
    xs) | Int
    i Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    0 = ([Dom (Name, Type)], Substitution)
    -> m ([Dom (Name, Type)], Substitution)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (([Dom (Name, Type)], Substitution)
     -> m ([Dom (Name, Type)], Substitution))
    -> ([Dom (Name, Type)], Substitution)
    -> m ([Dom (Name, Type)], Substitution)
    forall a b. (a -> b) -> a -> b
    $ ([Dom (Name, Type)]
    xs , Int -> Term -> Substitution
    forall a. DeBruijn a => Int -> a -> Substitution' a
    singletonS Int
    0 Term
    t)
        substContext Int
    i Term
    t (Dom (Name, Type)
    x:[Dom (Name, Type)]
    xs) | Int
    i Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    0 = do
                                      VerboseKey -> Int -> TCMT IO Doc -> m ()
    forall (m :: * -> *).
    MonadDebug m =>
    VerboseKey -> Int -> TCMT IO Doc -> m ()
    reportSDoc VerboseKey
    "conv.forall" Int
    20 (TCMT IO Doc -> m ()) -> TCMT IO Doc -> m ()
    forall a b. (a -> b) -> a -> b
    $
                                        [TCMT IO Doc] -> TCMT IO Doc
    forall (m :: * -> *) (t :: * -> *).
    (Applicative m, Foldable t) =>
    t (m Doc) -> m Doc
    fsep [TCMT IO Doc
    "substContext"
                                            , VerboseKey -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => VerboseKey -> m Doc
    text (Int -> VerboseKey
    forall a. Show a => a -> VerboseKey
    show (Int
    iInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    1))
                                            , Term -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM Term
    t
                                            , [Dom (Name, Type)] -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM [Dom (Name, Type)]
    xs
                                            ]
                                      ([Dom (Name, Type)]
    c,Substitution
    sigma) <- Int
    -> Term
    -> [Dom (Name, Type)]
    -> m ([Dom (Name, Type)], Substitution)
    forall (m :: * -> *).
    MonadConversion m =>
    Int
    -> Term
    -> [Dom (Name, Type)]
    -> m ([Dom (Name, Type)], Substitution)
    substContext (Int
    iInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    1) Term
    t [Dom (Name, Type)]
    xs
                                      let e :: Dom (Name, Type)
    e = Substitution' (SubstArg (Dom (Name, Type)))
    -> Dom (Name, Type) -> Dom (Name, Type)
    forall a. Subst a => Substitution' (SubstArg a) -> a -> a
    applySubst Substitution
    Substitution' (SubstArg (Dom (Name, Type)))
    sigma Dom (Name, Type)
    x
                                      ([Dom (Name, Type)], Substitution)
    -> m ([Dom (Name, Type)], Substitution)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Dom (Name, Type)
    eDom (Name, Type) -> [Dom (Name, Type)] -> [Dom (Name, Type)]
    forall a. a -> [a] -> [a]
    :[Dom (Name, Type)]
    c, Int -> Substitution -> Substitution
    forall a. Int -> Substitution' a -> Substitution' a
    liftS Int
    1 Substitution
    sigma)
        substContext Int
    i Term
    t (Dom (Name, Type)
    x:[Dom (Name, Type)]
    xs) = m ([Dom (Name, Type)], Substitution)
    forall a. HasCallStack => a
    __IMPOSSIBLE__

    compareInterval :: MonadConversion m => Comparison -> Type -> Term -> Term -> m ()
    compareInterval :: forall (m :: * -> *).
    MonadConversion m =>
    Comparison -> Type -> Term -> Term -> m ()
    compareInterval Comparison
    cmp Type
    i Term
    t Term
    u = do
      VerboseKey -> Int -> TCMT IO Doc -> m ()
    forall (m :: * -> *).
    MonadDebug m =>
    VerboseKey -> Int -> TCMT IO Doc -> m ()
    reportSDoc VerboseKey
    "tc.conv.interval" Int
    15 (TCMT IO Doc -> m ()) -> TCMT IO Doc -> m ()
    forall a b. (a -> b) -> a -> b
    $
        [TCMT IO Doc] -> TCMT IO Doc
    forall (m :: * -> *) (t :: * -> *).
    (Applicative m, Foldable t) =>
    t (m Doc) -> m Doc
    sep [ TCMT IO Doc
    "{ compareInterval" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> Term -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM Term
    t TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> TCMT IO Doc
    "=" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> Term -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM Term
    u ]
      Blocked Term
    tb <- Term -> m (Blocked Term)
    forall a (m :: * -> *).
    (Reduce a, MonadReduce m) =>
    a -> m (Blocked a)
    reduceB Term
    t
      Blocked Term
    ub <- Term -> m (Blocked Term)
    forall a (m :: * -> *).
    (Reduce a, MonadReduce m) =>
    a -> m (Blocked a)
    reduceB Term
    u
      let t :: Term
    t = Blocked Term -> Term
    forall t a. Blocked' t a -> a
    ignoreBlocking Blocked Term
    tb
          u :: Term
    u = Blocked Term -> Term
    forall t a. Blocked' t a -> a
    ignoreBlocking Blocked Term
    ub
      [(Map Int (Set Bool), [Term])]
    it <- Term -> m [(Map Int (Set Bool), [Term])]
    forall (m :: * -> *).
    HasBuiltins m =>
    Term -> m [(Map Int (Set Bool), [Term])]
    decomposeInterval' Term
    t
      [(Map Int (Set Bool), [Term])]
    iu <- Term -> m [(Map Int (Set Bool), [Term])]
    forall (m :: * -> *).
    HasBuiltins m =>
    Term -> m [(Map Int (Set Bool), [Term])]
    decomposeInterval' Term
    u
      case () of
        ()
    _ | Blocked Term -> Bool
    forall {t} {a}. Blocked' t a -> Bool
    isBlocked Blocked Term
    tb Bool -> Bool -> Bool
    || Blocked Term -> Bool
    forall {t} {a}. Blocked' t a -> Bool
    isBlocked Blocked Term
    ub -> do
          -- in case of metas we wouldn't be able to make progress by how we deal with de morgan laws.
          -- (because the constraints generated by decomposition are sufficient but not necessary).
          -- but we could still prune/solve some metas by comparing the terms as atoms.
          -- also if blocked we won't find the terms conclusively unequal(?) so compareAtom
          -- won't report type errors when we should accept.
          Type
    interval <- m Type
    forall (m :: * -> *).
    (HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
    m Type
    primIntervalType
          Comparison -> CompareAs -> Term -> Term -> m ()
    forall (m :: * -> *).
    MonadConversion m =>
    Comparison -> CompareAs -> Term -> Term -> m ()
    compareAtom Comparison
    CmpEq (Type -> CompareAs
    AsTermsOf Type
    interval) Term
    t Term
    u
        ()
    _ | Bool
    otherwise -> do
          Bool
    x <- [(Map Int (Set Bool), [Term])]
    -> [(Map Int (Set Bool), [Term])] -> m Bool
    forall (m :: * -> *).
    MonadConversion m =>
    [(Map Int (Set Bool), [Term])]
    -> [(Map Int (Set Bool), [Term])] -> m Bool
    leqInterval [(Map Int (Set Bool), [Term])]
    it [(Map Int (Set Bool), [Term])]
    iu
          Bool
    y <- [(Map Int (Set Bool), [Term])]
    -> [(Map Int (Set Bool), [Term])] -> m Bool
    forall (m :: * -> *).
    MonadConversion m =>
    [(Map Int (Set Bool), [Term])]
    -> [(Map Int (Set Bool), [Term])] -> m Bool
    leqInterval [(Map Int (Set Bool), [Term])]
    iu [(Map Int (Set Bool), [Term])]
    it
          let final :: Bool
    final = [(Map Int (Set Bool), [Term])] -> Bool
    isCanonical [(Map Int (Set Bool), [Term])]
    it Bool -> Bool -> Bool
    && [(Map Int (Set Bool), [Term])] -> Bool
    isCanonical [(Map Int (Set Bool), [Term])]
    iu
          if Bool
    x Bool -> Bool -> Bool
    && Bool
    y then VerboseKey -> Int -> TCMT IO Doc -> m ()
    forall (m :: * -> *).
    MonadDebug m =>
    VerboseKey -> Int -> TCMT IO Doc -> m ()
    reportSDoc VerboseKey
    "tc.conv.interval" Int
    15 (TCMT IO Doc -> m ()) -> TCMT IO Doc -> m ()
    forall a b. (a -> b) -> a -> b
    $ TCMT IO Doc
    "Ok! }" else
            if Bool
    final then TypeError -> m ()
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCError m) =>
    TypeError -> m a
    typeError (TypeError -> m ()) -> TypeError -> m ()
    forall a b. (a -> b) -> a -> b
    $ Comparison -> Term -> Term -> CompareAs -> TypeError
    UnequalTerms Comparison
    cmp Term
    t Term
    u (Type -> CompareAs
    AsTermsOf Type
    i)
                     else do
                       VerboseKey -> Int -> TCMT IO Doc -> m ()
    forall (m :: * -> *).
    MonadDebug m =>
    VerboseKey -> Int -> TCMT IO Doc -> m ()
    reportSDoc VerboseKey
    "tc.conv.interval" Int
    15 (TCMT IO Doc -> m ()) -> TCMT IO Doc -> m ()
    forall a b. (a -> b) -> a -> b
    $ TCMT IO Doc
    "Giving up! }"
                       Blocker -> m ()
    forall (m :: * -> *) a. MonadBlock m => Blocker -> m a
    patternViolation ((Term, Term) -> Blocker
    forall t. AllMetas t => t -> Blocker
    unblockOnAnyMetaIn (Term
    t, Term
    u))
     where
       isBlocked :: Blocked' t a -> Bool
    isBlocked Blocked{}    = Bool
    True
       isBlocked NotBlocked{} = Bool
    False

    type Conj = (Map.Map Int (Set.Set Bool),[Term])

    isCanonical :: [Conj] -> Bool
    isCanonical :: [(Map Int (Set Bool), [Term])] -> Bool
    isCanonical = ((Map Int (Set Bool), [Term]) -> Bool)
    -> [(Map Int (Set Bool), [Term])] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all ([Term] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null ([Term] -> Bool)
    -> ((Map Int (Set Bool), [Term]) -> [Term])
    -> (Map Int (Set Bool), [Term])
    -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Map Int (Set Bool), [Term]) -> [Term]
    forall a b. (a, b) -> b
    snd)

    -- | leqInterval r q = r ≤ q in the I lattice.
    -- (∨ r_i) ≤ (∨ q_j)  iff  ∀ i. ∃ j. r_i ≤ q_j
    leqInterval :: MonadConversion m => [Conj] -> [Conj] -> m Bool
    leqInterval :: forall (m :: * -> *).
    MonadConversion m =>
    [(Map Int (Set Bool), [Term])]
    -> [(Map Int (Set Bool), [Term])] -> m Bool
    leqInterval [(Map Int (Set Bool), [Term])]
    r [(Map Int (Set Bool), [Term])]
    q =
      [Bool] -> Bool
    forall (t :: * -> *). Foldable t => t Bool -> Bool
    and ([Bool] -> Bool) -> m [Bool] -> m Bool
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [(Map Int (Set Bool), [Term])]
    -> ((Map Int (Set Bool), [Term]) -> m Bool) -> m [Bool]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    t a -> (a -> m b) -> m (t b)
    forM [(Map Int (Set Bool), [Term])]
    r (\ (Map Int (Set Bool), [Term])
    r_i ->
       [Bool] -> Bool
    forall (t :: * -> *). Foldable t => t Bool -> Bool
    or ([Bool] -> Bool) -> m [Bool] -> m Bool
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [(Map Int (Set Bool), [Term])]
    -> ((Map Int (Set Bool), [Term]) -> m Bool) -> m [Bool]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    t a -> (a -> m b) -> m (t b)
    forM [(Map Int (Set Bool), [Term])]
    q (\ (Map Int (Set Bool), [Term])
    q_j -> (Map Int (Set Bool), [Term])
    -> (Map Int (Set Bool), [Term]) -> m Bool
    forall (m :: * -> *).
    MonadConversion m =>
    (Map Int (Set Bool), [Term])
    -> (Map Int (Set Bool), [Term]) -> m Bool
    leqConj (Map Int (Set Bool), [Term])
    r_i (Map Int (Set Bool), [Term])
    q_j))  -- TODO shortcut

    -- | leqConj r q = r ≤ q in the I lattice, when r and q are conjuctions.
    -- ' (∧ r_i)   ≤ (∧ q_j)               iff
    -- ' (∧ r_i)   ∧ (∧ q_j)   = (∧ r_i)   iff
    -- ' {r_i | i} ∪ {q_j | j} = {r_i | i} iff
    -- ' {q_j | j} ⊆ {r_i | i}
    leqConj :: MonadConversion m => Conj -> Conj -> m Bool
    leqConj :: forall (m :: * -> *).
    MonadConversion m =>
    (Map Int (Set Bool), [Term])
    -> (Map Int (Set Bool), [Term]) -> m Bool
    leqConj (Map Int (Set Bool)
    rs, [Term]
    rst) (Map Int (Set Bool)
    qs, [Term]
    qst) = do
      if Map Int (Set Bool) -> Set (Int, Bool)
    forall {a} {b}. (Ord a, Ord b) => Map a (Set b) -> Set (a, b)
    toSet Map Int (Set Bool)
    qs Set (Int, Bool) -> Set (Int, Bool) -> Bool
    forall a. Ord a => Set a -> Set a -> Bool
    `Set.isSubsetOf` Map Int (Set Bool) -> Set (Int, Bool)
    forall {a} {b}. (Ord a, Ord b) => Map a (Set b) -> Set (a, b)
    toSet Map Int (Set Bool)
    rs
        then do
          Type
    interval <-
            m Term -> m Type
    forall (m :: * -> *). Functor m => m Term -> m Type
    elSSet (m Term -> m Type) -> m Term -> m Type
    forall a b. (a -> b) -> a -> b
    $ Term -> Maybe Term -> Term
    forall a. a -> Maybe a -> a
    fromMaybe Term
    forall a. HasCallStack => a
    __IMPOSSIBLE__ (Maybe Term -> Term) -> m (Maybe Term) -> m Term
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> VerboseKey -> m (Maybe Term)
    forall (m :: * -> *). HasBuiltins m => VerboseKey -> m (Maybe Term)
    getBuiltin' VerboseKey
    builtinInterval
          -- we don't want to generate new constraints here because
          -- 1. in some situations the same constraint would get generated twice.
          -- 2. unless things are completely accepted we are going to
          --    throw patternViolation in compareInterval.
          let eqT :: Term -> Term -> m Bool
    eqT Term
    t Term
    u = m () -> m Bool
    forall (m :: * -> *).
    (MonadConstraint m, MonadWarning m, MonadError TCErr m,
     MonadFresh ProblemId m) =>
    m () -> m Bool
    tryConversion (Comparison -> CompareAs -> Term -> Term -> m ()
    forall (m :: * -> *).
    MonadConversion m =>
    Comparison -> CompareAs -> Term -> Term -> m ()
    compareAtom Comparison
    CmpEq (Type -> CompareAs
    AsTermsOf Type
    interval) Term
    t Term
    u)
          let listSubset :: [Term] -> [Term] -> m Bool
    listSubset [Term]
    ts [Term]
    us =
                [Bool] -> Bool
    forall (t :: * -> *). Foldable t => t Bool -> Bool
    and ([Bool] -> Bool) -> m [Bool] -> m Bool
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [Term] -> (Term -> m Bool) -> m [Bool]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    t a -> (a -> m b) -> m (t b)
    forM [Term]
    ts (\Term
    t -> [Bool] -> Bool
    forall (t :: * -> *). Foldable t => t Bool -> Bool
    or ([Bool] -> Bool) -> m [Bool] -> m Bool
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [Term] -> (Term -> m Bool) -> m [Bool]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    t a -> (a -> m b) -> m (t b)
    forM [Term]
    us (\Term
    u -> Term -> Term -> m Bool
    eqT Term
    t Term
    u)) -- TODO shortcut
          [Term] -> [Term] -> m Bool
    listSubset [Term]
    qst [Term]
    rst
        else
          Bool -> m Bool
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    False
      where
        toSet :: Map a (Set b) -> Set (a, b)
    toSet Map a (Set b)
    m = [(a, b)] -> Set (a, b)
    forall a. Ord a => [a] -> Set a
    Set.fromList [(a
    i, b
    b) | (a
    i, Set b
    bs) <- Map a (Set b) -> [(a, Set b)]
    forall k a. Map k a -> [(k, a)]
    Map.toList Map a (Set b)
    m, b
    b <- Set b -> [b]
    forall a. Set a -> [a]
    Set.toList Set b
    bs]

    -- | equalTermOnFace φ A u v = _ , φ ⊢ u = v : A
    equalTermOnFace :: MonadConversion m => Term -> Type -> Term -> Term -> m ()
    equalTermOnFace :: forall (m :: * -> *).
    MonadConversion m =>
    Term -> Type -> Term -> Term -> m ()
    equalTermOnFace = Comparison -> Term -> Type -> Term -> Term -> m ()
    forall (m :: * -> *).
    MonadConversion m =>
    Comparison -> Term -> Type -> Term -> Term -> m ()
    compareTermOnFace Comparison
    CmpEq

    compareTermOnFace :: MonadConversion m => Comparison -> Term -> Type -> Term -> Term -> m ()
    compareTermOnFace :: forall (m :: * -> *).
    MonadConversion m =>
    Comparison -> Term -> Type -> Term -> Term -> m ()
    compareTermOnFace = (Comparison -> Type -> Term -> Term -> m ())
    -> Comparison -> Term -> Type -> Term -> Term -> m ()
    forall (m :: * -> *).
    MonadConversion m =>
    (Comparison -> Type -> Term -> Term -> m ())
    -> Comparison -> Term -> Type -> Term -> Term -> m ()
    compareTermOnFace' Comparison -> Type -> Term -> Term -> m ()
    forall (m :: * -> *).
    MonadConversion m =>
    Comparison -> Type -> Term -> Term -> m ()
    compareTerm

    compareTermOnFace' :: MonadConversion m => (Comparison -> Type -> Term -> Term -> m ()) -> Comparison -> Term -> Type -> Term -> Term -> m ()
    compareTermOnFace' :: forall (m :: * -> *).
    MonadConversion m =>
    (Comparison -> Type -> Term -> Term -> m ())
    -> Comparison -> Term -> Type -> Term -> Term -> m ()
    compareTermOnFace' Comparison -> Type -> Term -> Term -> m ()
    k Comparison
    cmp Term
    phi Type
    ty Term
    u Term
    v = do
      VerboseKey -> Int -> TCMT IO Doc -> m ()
    forall (m :: * -> *).
    MonadDebug m =>
    VerboseKey -> Int -> TCMT IO Doc -> m ()
    reportSDoc VerboseKey
    "tc.conv.face" Int
    40 (TCMT IO Doc -> m ()) -> TCMT IO Doc -> m ()
    forall a b. (a -> b) -> a -> b
    $
        VerboseKey -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => VerboseKey -> m Doc
    text VerboseKey
    "compareTermOnFace:" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> Term -> TCMT IO Doc
    forall (m :: * -> *) a. (Applicative m, Pretty a) => a -> m Doc
    pretty Term
    phi TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> TCMT IO Doc
    "|-" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> Term -> TCMT IO Doc
    forall (m :: * -> *) a. (Applicative m, Pretty a) => a -> m Doc
    pretty Term
    u TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> TCMT IO Doc
    "==" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> Term -> TCMT IO Doc
    forall (m :: * -> *) a. (Applicative m, Pretty a) => a -> m Doc
    pretty Term
    v TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> TCMT IO Doc
    ":" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> Type -> TCMT IO Doc
    forall (m :: * -> *) a. (Applicative m, Pretty a) => a -> m Doc
    pretty Type
    ty

      Term
    phi <- Term -> m Term
    forall a (m :: * -> *). (Reduce a, MonadReduce m) => a -> m a
    reduce Term
    phi
      [()]
    _ <- Term
    -> (Map Int Bool -> Blocker -> Term -> m ())
    -> (Substitution -> m ())
    -> m [()]
    forall (m :: * -> *) a.
    MonadConversion m =>
    Term
    -> (Map Int Bool -> Blocker -> Term -> m a)
    -> (Substitution -> m a)
    -> m [a]
    forallFaceMaps Term
    phi Map Int Bool -> Blocker -> Term -> m ()
    postponed
             ((Substitution -> m ()) -> m [()])
    -> (Substitution -> m ()) -> m [()]
    forall a b. (a -> b) -> a -> b
    $ \ Substitution
    alpha -> Comparison -> Type -> Term -> Term -> m ()
    k Comparison
    cmp (Substitution' (SubstArg Type) -> Type -> Type
    forall a. Subst a => Substitution' (SubstArg a) -> a -> a
    applySubst Substitution
    Substitution' (SubstArg Type)
    alpha Type
    ty) (Substitution' (SubstArg Term) -> Term -> Term
    forall a. Subst a => Substitution' (SubstArg a) -> a -> a
    applySubst Substitution
    Substitution' (SubstArg Term)
    alpha Term
    u) (Substitution' (SubstArg Term) -> Term -> Term
    forall a. Subst a => Substitution' (SubstArg a) -> a -> a
    applySubst Substitution
    Substitution' (SubstArg Term)
    alpha Term
    v)
      () -> m ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
     where
      postponed :: Map Int Bool -> Blocker -> Term -> m ()
    postponed Map Int Bool
    ms Blocker
    blocker Term
    psi = do
        Term
    phi <- Names -> NamesT m Term -> m Term
    forall (m :: * -> *) a. Names -> NamesT m a -> m a
    runNamesT [] (NamesT m Term -> m Term) -> NamesT m Term -> m Term
    forall a b. (a -> b) -> a -> b
    $ do
                 Term
    imin <- m Term -> NamesT m Term
    forall (m :: * -> *) a. Monad m => m a -> NamesT m a
    cl (m Term -> NamesT m Term) -> m Term -> NamesT m Term
    forall a b. (a -> b) -> a -> b
    $ VerboseKey -> m Term
    forall (m :: * -> *).
    (HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
    VerboseKey -> m Term
    getPrimitiveTerm VerboseKey
    "primIMin"
                 Term
    ineg <- m Term -> NamesT m Term
    forall (m :: * -> *) a. Monad m => m a -> NamesT m a
    cl (m Term -> NamesT m Term) -> m Term -> NamesT m Term
    forall a b. (a -> b) -> a -> b
    $ VerboseKey -> m Term
    forall (m :: * -> *).
    (HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
    VerboseKey -> m Term
    getPrimitiveTerm VerboseKey
    "primINeg"
                 NamesT m Term
    psi <- Term -> NamesT m (NamesT m Term)
    forall (m :: * -> *) a.
    (MonadFail m, Subst a) =>
    a -> NamesT m (NamesT m a)
    open Term
    psi
                 let phi :: NamesT m Term
    phi = ((Int, Bool) -> NamesT m Term -> NamesT m Term)
    -> NamesT m Term -> [(Int, Bool)] -> NamesT m Term
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr (\ (Int
    i,Bool
    b) NamesT m Term
    r -> do NamesT m Term
    i <- Term -> NamesT m (NamesT m Term)
    forall (m :: * -> *) a.
    (MonadFail m, Subst a) =>
    a -> NamesT m (NamesT m a)
    open (Int -> Term
    var Int
    i); Term -> NamesT m Term
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Term
    imin NamesT m Term -> NamesT m Term -> NamesT m Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <@> (if Bool
    b then NamesT m Term
    i else Term -> NamesT m Term
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Term
    ineg NamesT m Term -> NamesT m Term -> NamesT m Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <@> NamesT m Term
    i) NamesT m Term -> NamesT m Term -> NamesT m Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <@> NamesT m Term
    r)
                              NamesT m Term
    psi (Map Int Bool -> [(Int, Bool)]
    forall k a. Map k a -> [(k, a)]
    Map.toList Map Int Bool
    ms) -- TODO Andrea: make a view?
                 NamesT m Term
    phi
        Blocker -> Constraint -> m ()
    forall (m :: * -> *).
    MonadConstraint m =>
    Blocker -> Constraint -> m ()
    addConstraint Blocker
    blocker (Comparison -> Term -> Type -> Term -> Term -> Constraint
    ValueCmpOnFace Comparison
    cmp Term
    phi Type
    ty Term
    u Term
    v)

    ---------------------------------------------------------------------------
    -- * Definitions
    ---------------------------------------------------------------------------

    bothAbsurd :: MonadConversion m => QName -> QName -> m Bool
    bothAbsurd :: forall (m :: * -> *). MonadConversion m => QName -> QName -> m Bool
    bothAbsurd QName
    f QName
    f'
      | QName -> Bool
    isAbsurdLambdaName QName
    f, QName -> Bool
    isAbsurdLambdaName QName
    f' = do
          -- Double check we are really dealing with absurd lambdas:
          -- Their functions should not have bodies.
          Definition
    def  <- QName -> m Definition
    forall (m :: * -> *). HasConstInfo m => QName -> m Definition
    getConstInfo QName
    f
          Definition
    def' <- QName -> m Definition
    forall (m :: * -> *). HasConstInfo m => QName -> m Definition
    getConstInfo QName
    f'
          case (Definition -> Defn
    theDef Definition
    def, Definition -> Defn
    theDef Definition
    def') of
            (Function{ funClauses :: Defn -> [Clause]
    funClauses = [Clause{ clauseBody :: Clause -> Maybe Term
    clauseBody = Maybe Term
    Nothing }] },
             Function{ funClauses :: Defn -> [Clause]
    funClauses = [Clause{ clauseBody :: Clause -> Maybe Term
    clauseBody = Maybe Term
    Nothing }] }) -> Bool -> m Bool
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    True
            (Defn, Defn)
    _ -> Bool -> m Bool
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    False
      | Bool
    otherwise = Bool -> m Bool
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    False