    {-# LANGUAGE NondecreasingIndentation #-}

    module Agda.TypeChecking.Rules.LHS
      ( checkLeftHandSide
      , LHSResult(..)
      , bindAsPatterns
      , IsFlexiblePattern(..)
      , DataOrRecord(..)
      , checkSortOfSplitVar
      ) where

    import Prelude hiding ( null )

    import Data.Function (on)
    import Data.Maybe

    import Control.Arrow (left, second)
    import Control.Monad
    import Control.Monad.Except
    import Control.Monad.Reader
    import Control.Monad.Writer       ( MonadWriter(..), runWriterT )
    import Control.Monad.Trans.Maybe

    import Data.IntSet (IntSet)
    import qualified Data.IntSet as IntSet
    import Data.List (findIndex)
    import qualified Data.List as List
    import Data.Semigroup ( Semigroup )
    import qualified Data.Semigroup as Semigroup
    import Data.Map (Map)
    import qualified Data.Map as Map

    import Agda.Interaction.Highlighting.Generate
      ( storeDisambiguatedConstructor, storeDisambiguatedProjection, disambiguateRecordFields)
    import Agda.Interaction.Options
    import Agda.Interaction.Options.Lenses

    import Agda.Syntax.Internal as I hiding (DataOrRecord(..))
    import Agda.Syntax.Internal.Pattern
    import qualified Agda.Syntax.Abstract as A
    import Agda.Syntax.Abstract.Views (asView, deepUnscope)
    import Agda.Syntax.Concrete (FieldAssignment'(..),LensInScope(..))
    import Agda.Syntax.Common as Common
    import Agda.Syntax.Info as A
    import Agda.Syntax.Literal
    import Agda.Syntax.Position

    import Agda.TypeChecking.Monad

    import qualified Agda.TypeChecking.Monad.Benchmark as Bench
    import Agda.TypeChecking.Conversion
    import Agda.TypeChecking.Constraints
    import Agda.TypeChecking.CheckInternal (checkInternal)
    import Agda.TypeChecking.Datatypes hiding (isDataOrRecordType)
    import Agda.TypeChecking.Errors (dropTopLevelModule)
    import Agda.TypeChecking.Irrelevance
    -- Prevent "Ambiguous occurrence ‘DontKnow’" when loading with ghci.
    -- (DontKnow is one of the constructors of ErrorNonEmpty *and* UnifactionResult').
    -- We can't explicitly hide just the constructor here because it isn't in the
    -- hs-boot file.
    import {-# SOURCE #-} Agda.TypeChecking.Empty (ensureEmptyType)
    import Agda.TypeChecking.Patterns.Abstract
    import Agda.TypeChecking.Pretty
    import Agda.TypeChecking.Records hiding (getRecordConstructor)
    import Agda.TypeChecking.Reduce
    import Agda.TypeChecking.Substitute
    import Agda.TypeChecking.Telescope
    import Agda.TypeChecking.Telescope.Path
    import Agda.TypeChecking.Primitive hiding (Nat)

    import {-# SOURCE #-} Agda.TypeChecking.Rules.Term (checkExpr, isType_)
    import Agda.TypeChecking.Rules.LHS.Problem
    import Agda.TypeChecking.Rules.LHS.ProblemRest
    import Agda.TypeChecking.Rules.LHS.Unify
    import Agda.TypeChecking.Rules.LHS.Implicit
    import Agda.TypeChecking.Rules.Data

    import Agda.Utils.CallStack ( HasCallStack, withCallerCallStack )
    import Agda.Utils.Function
    import Agda.Utils.Functor
    import Agda.Utils.Lens
    import Agda.Utils.List
    import Agda.Utils.List1 (List1, pattern (:|))
    import qualified Agda.Utils.List  as List
    import qualified Agda.Utils.List1 as List1
    import Agda.Utils.Maybe
    import Agda.Utils.Monad
    import Agda.Utils.Null
    import Agda.Utils.Pretty (prettyShow)
    import Agda.Utils.Singleton
    import Agda.Utils.Size
    import Agda.Utils.Tuple

    import Agda.Utils.Impossible

    --UNUSED Liang-Ting Chen 2019-07-16
    ---- | Compute the set of flexible patterns in a list of patterns. The result is
    ----   the deBruijn indices of the flexible patterns.
    --flexiblePatterns :: [NamedArg A.Pattern] -> TCM FlexibleVars
    --flexiblePatterns nps = do
    --  forMaybeM (zip (downFrom $ length nps) nps) $ \ (i, Arg ai p) -> do
    --    runMaybeT $ (\ f -> FlexibleVar (getHiding ai) (getOrigin ai) f (Just i) i) <$> maybeFlexiblePattern p

    -- | A pattern is flexible if it is dotted or implicit, or a record pattern
    --   with only flexible subpatterns.
    class IsFlexiblePattern a where
      maybeFlexiblePattern :: (HasConstInfo m, MonadDebug m) => a -> MaybeT m FlexibleVarKind

      isFlexiblePattern :: (HasConstInfo m, MonadDebug m) => a -> m Bool
      isFlexiblePattern a
    p =
        Bool -> (FlexibleVarKind -> Bool) -> Maybe FlexibleVarKind -> Bool
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Bool
    False FlexibleVarKind -> Bool
    notOtherFlex (Maybe FlexibleVarKind -> Bool)
    -> m (Maybe FlexibleVarKind) -> m Bool
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> MaybeT m FlexibleVarKind -> m (Maybe FlexibleVarKind)
    forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
    runMaybeT (a -> MaybeT m FlexibleVarKind
    forall a (m :: * -> *).
    (IsFlexiblePattern a, HasConstInfo m, MonadDebug m) =>
    a -> MaybeT m FlexibleVarKind
    maybeFlexiblePattern a
    p)
        where
        notOtherFlex :: FlexibleVarKind -> Bool
    notOtherFlex = \case
          RecordFlex [FlexibleVarKind]
    fls -> (FlexibleVarKind -> Bool) -> [FlexibleVarKind] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all FlexibleVarKind -> Bool
    notOtherFlex [FlexibleVarKind]
    fls
          FlexibleVarKind
    ImplicitFlex   -> Bool
    True
          FlexibleVarKind
    DotFlex        -> Bool
    True
          FlexibleVarKind
    OtherFlex      -> Bool
    False

    instance IsFlexiblePattern A.Pattern where
      maybeFlexiblePattern :: forall (m :: * -> *).
    (HasConstInfo m, MonadDebug m) =>
    Pattern -> MaybeT m FlexibleVarKind
    maybeFlexiblePattern Pattern
    p = do
        [Char] -> Int -> TCMT IO Doc -> MaybeT m ()
    forall (m :: * -> *).
    MonadDebug m =>
    [Char] -> Int -> TCMT IO Doc -> m ()
    reportSDoc [Char]
    "tc.lhs.flex" Int
    30 (TCMT IO Doc -> MaybeT m ()) -> TCMT IO Doc -> MaybeT m ()
    forall a b. (a -> b) -> a -> b
    $ TCMT IO Doc
    "maybeFlexiblePattern" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> Pattern -> TCMT IO Doc
    forall a (m :: * -> *).
    (ToConcrete a, Pretty (ConOfAbs a), MonadAbsToCon m) =>
    a -> m Doc
    prettyA Pattern
    p
        [Char] -> Int -> TCMT IO Doc -> MaybeT m ()
    forall (m :: * -> *).
    MonadDebug m =>
    [Char] -> Int -> TCMT IO Doc -> m ()
    reportSDoc [Char]
    "tc.lhs.flex" Int
    60 (TCMT IO Doc -> MaybeT m ()) -> TCMT IO Doc -> MaybeT m ()
    forall a b. (a -> b) -> a -> b
    $ TCMT IO Doc
    "maybeFlexiblePattern (raw) " TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> ([Char] -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => [Char] -> m Doc
    text ([Char] -> TCMT IO Doc)
    -> (Pattern -> [Char]) -> Pattern -> TCMT IO Doc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Pattern -> [Char]
    forall a. Show a => a -> [Char]
    show (Pattern -> [Char]) -> (Pattern -> Pattern) -> Pattern -> [Char]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Pattern -> Pattern
    forall a. ExprLike a => a -> a
    deepUnscope) Pattern
    p
        case Pattern
    p of
          A.DotP{}  -> FlexibleVarKind -> MaybeT m FlexibleVarKind
    forall (m :: * -> *) a. Monad m => a -> m a
    return FlexibleVarKind
    DotFlex
          A.VarP{}  -> FlexibleVarKind -> MaybeT m FlexibleVarKind
    forall (m :: * -> *) a. Monad m => a -> m a
    return FlexibleVarKind
    ImplicitFlex
          A.WildP{} -> FlexibleVarKind -> MaybeT m FlexibleVarKind
    forall (m :: * -> *) a. Monad m => a -> m a
    return FlexibleVarKind
    ImplicitFlex
          A.AsP PatInfo
    _ BindName
    _ Pattern
    p -> Pattern -> MaybeT m FlexibleVarKind
    forall a (m :: * -> *).
    (IsFlexiblePattern a, HasConstInfo m, MonadDebug m) =>
    a -> MaybeT m FlexibleVarKind
    maybeFlexiblePattern Pattern
    p
          A.ConP ConPatInfo
    _ AmbiguousQName
    cs [NamedArg Pattern]
    qs | Just QName
    c <- AmbiguousQName -> Maybe QName
    getUnambiguous AmbiguousQName
    cs ->
            MaybeT m Bool
    -> MaybeT m FlexibleVarKind
    -> MaybeT m FlexibleVarKind
    -> MaybeT m FlexibleVarKind
    forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
    ifM (Maybe (QName, Defn) -> Bool
    forall a. Maybe a -> Bool
    isNothing (Maybe (QName, Defn) -> Bool)
    -> MaybeT m (Maybe (QName, Defn)) -> MaybeT m Bool
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> QName -> MaybeT m (Maybe (QName, Defn))
    forall (m :: * -> *).
    HasConstInfo m =>
    QName -> m (Maybe (QName, Defn))
    isRecordConstructor QName
    c) (FlexibleVarKind -> MaybeT m FlexibleVarKind
    forall (m :: * -> *) a. Monad m => a -> m a
    return FlexibleVarKind
    OtherFlex) {-else-}
                ([NamedArg Pattern] -> MaybeT m FlexibleVarKind
    forall a (m :: * -> *).
    (IsFlexiblePattern a, HasConstInfo m, MonadDebug m) =>
    a -> MaybeT m FlexibleVarKind
    maybeFlexiblePattern [NamedArg Pattern]
    qs)
          A.LitP{}  -> FlexibleVarKind -> MaybeT m FlexibleVarKind
    forall (m :: * -> *) a. Monad m => a -> m a
    return FlexibleVarKind
    OtherFlex
          A.AnnP PatInfo
    _ Expr
    _ Pattern
    p -> Pattern -> MaybeT m FlexibleVarKind
    forall a (m :: * -> *).
    (IsFlexiblePattern a, HasConstInfo m, MonadDebug m) =>
    a -> MaybeT m FlexibleVarKind
    maybeFlexiblePattern Pattern
    p
          Pattern
    _ -> MaybeT m FlexibleVarKind
    forall (m :: * -> *) a. MonadPlus m => m a
    mzero

    instance IsFlexiblePattern (I.Pattern' a) where
      maybeFlexiblePattern :: forall (m :: * -> *).
    (HasConstInfo m, MonadDebug m) =>
    Pattern' a -> MaybeT m FlexibleVarKind
    maybeFlexiblePattern Pattern' a
    p =
        case Pattern' a
    p of
          I.DotP{}  -> FlexibleVarKind -> MaybeT m FlexibleVarKind
    forall (m :: * -> *) a. Monad m => a -> m a
    return FlexibleVarKind
    DotFlex
          I.ConP ConHead
    _ ConPatternInfo
    i [NamedArg (Pattern' a)]
    ps
            | ConPatternInfo -> Bool
    conPRecord ConPatternInfo
    i , PatOrigin
    PatOSystem <- PatternInfo -> PatOrigin
    patOrigin (ConPatternInfo -> PatternInfo
    conPInfo ConPatternInfo
    i) -> FlexibleVarKind -> MaybeT m FlexibleVarKind
    forall (m :: * -> *) a. Monad m => a -> m a
    return FlexibleVarKind
    ImplicitFlex  -- expanded from ImplicitP
            | ConPatternInfo -> Bool
    conPRecord ConPatternInfo
    i -> [NamedArg (Pattern' a)] -> MaybeT m FlexibleVarKind
    forall a (m :: * -> *).
    (IsFlexiblePattern a, HasConstInfo m, MonadDebug m) =>
    a -> MaybeT m FlexibleVarKind
    maybeFlexiblePattern [NamedArg (Pattern' a)]
    ps
            | Bool
    otherwise -> MaybeT m FlexibleVarKind
    forall (m :: * -> *) a. MonadPlus m => m a
    mzero
          I.VarP{}  -> MaybeT m FlexibleVarKind
    forall (m :: * -> *) a. MonadPlus m => m a
    mzero
          I.LitP{}  -> MaybeT m FlexibleVarKind
    forall (m :: * -> *) a. MonadPlus m => m a
    mzero
          I.ProjP{} -> MaybeT m FlexibleVarKind
    forall (m :: * -> *) a. MonadPlus m => m a
    mzero
          I.IApplyP{} -> MaybeT m FlexibleVarKind
    forall (m :: * -> *) a. MonadPlus m => m a
    mzero
          I.DefP{} -> MaybeT m FlexibleVarKind
    forall (m :: * -> *) a. MonadPlus m => m a
    mzero -- TODO Andrea check semantics

    -- | Lists of flexible patterns are 'RecordFlex'.
    instance IsFlexiblePattern a => IsFlexiblePattern [a] where
      maybeFlexiblePattern :: forall (m :: * -> *).
    (HasConstInfo m, MonadDebug m) =>
    [a] -> MaybeT m FlexibleVarKind
    maybeFlexiblePattern [a]
    ps = [FlexibleVarKind] -> FlexibleVarKind
    RecordFlex ([FlexibleVarKind] -> FlexibleVarKind)
    -> MaybeT m [FlexibleVarKind] -> MaybeT m FlexibleVarKind
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (a -> MaybeT m FlexibleVarKind)
    -> [a] -> MaybeT m [FlexibleVarKind]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM a -> MaybeT m FlexibleVarKind
    forall a (m :: * -> *).
    (IsFlexiblePattern a, HasConstInfo m, MonadDebug m) =>
    a -> MaybeT m FlexibleVarKind
    maybeFlexiblePattern [a]
    ps

    instance IsFlexiblePattern a => IsFlexiblePattern (Arg a) where
      maybeFlexiblePattern :: forall (m :: * -> *).
    (HasConstInfo m, MonadDebug m) =>
    Arg a -> MaybeT m FlexibleVarKind
    maybeFlexiblePattern = a -> MaybeT m FlexibleVarKind
    forall a (m :: * -> *).
    (IsFlexiblePattern a, HasConstInfo m, MonadDebug m) =>
    a -> MaybeT m FlexibleVarKind
    maybeFlexiblePattern (a -> MaybeT m FlexibleVarKind)
    -> (Arg a -> a) -> Arg a -> MaybeT m FlexibleVarKind
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Arg a -> a
    forall e. Arg e -> e
    unArg

    instance IsFlexiblePattern a => IsFlexiblePattern (Common.Named name a) where
      maybeFlexiblePattern :: forall (m :: * -> *).
    (HasConstInfo m, MonadDebug m) =>
    Named name a -> MaybeT m FlexibleVarKind
    maybeFlexiblePattern = a -> MaybeT m FlexibleVarKind
    forall a (m :: * -> *).
    (IsFlexiblePattern a, HasConstInfo m, MonadDebug m) =>
    a -> MaybeT m FlexibleVarKind
    maybeFlexiblePattern (a -> MaybeT m FlexibleVarKind)
    -> (Named name a -> a) -> Named name a -> MaybeT m FlexibleVarKind
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Named name a -> a
    forall name a. Named name a -> a
    namedThing

    -- | Update the given LHS state:
    --   1. simplify problem equations
    --   2. rename telescope variables
    --   3. introduce trailing patterns
    updateLHSState :: LHSState a -> TCM (LHSState a)
    updateLHSState :: forall a. LHSState a -> TCM (LHSState a)
    updateLHSState LHSState a
    st = do
      let tel :: Tele (Dom' Term Type)
    tel     = LHSState a
    st LHSState a
    -> Lens' (Tele (Dom' Term Type)) (LHSState a)
    -> Tele (Dom' Term Type)
    forall o i. o -> Lens' i o -> i
    ^. forall a. Lens' (Tele (Dom' Term Type)) (LHSState a)
    Lens' (Tele (Dom' Term Type)) (LHSState a)
    lhsTel
          problem :: Problem a
    problem = LHSState a
    st LHSState a -> Lens' (Problem a) (LHSState a) -> Problem a
    forall o i. o -> Lens' i o -> i
    ^. forall a. Lens' (Problem a) (LHSState a)
    Lens' (Problem a) (LHSState a)
    lhsProblem
      [ProblemEq]
    eqs' <- Tele (Dom' Term Type) -> TCMT IO [ProblemEq] -> TCMT IO [ProblemEq]
    forall b (m :: * -> *) a.
    (AddContext b, MonadAddContext m) =>
    b -> m a -> m a
    addContext Tele (Dom' Term Type)
    tel (TCMT IO [ProblemEq] -> TCMT IO [ProblemEq])
    -> TCMT IO [ProblemEq] -> TCMT IO [ProblemEq]
    forall a b. (a -> b) -> a -> b
    $ [ProblemEq] -> TCMT IO [ProblemEq]
    updateProblemEqs ([ProblemEq] -> TCMT IO [ProblemEq])
    -> [ProblemEq] -> TCMT IO [ProblemEq]
    forall a b. (a -> b) -> a -> b
    $ Problem a
    problem Problem a -> Lens' [ProblemEq] (Problem a) -> [ProblemEq]
    forall o i. o -> Lens' i o -> i
    ^. forall a. Lens' [ProblemEq] (Problem a)
    Lens' [ProblemEq] (Problem a)
    problemEqs
      Tele (Dom' Term Type)
    tel' <- [ProblemEq]
    -> Tele (Dom' Term Type) -> TCMT IO (Tele (Dom' Term Type))
    forall (m :: * -> *).
    PureTCM m =>
    [ProblemEq] -> Tele (Dom' Term Type) -> m (Tele (Dom' Term Type))
    useNamesFromProblemEqs [ProblemEq]
    eqs' Tele (Dom' Term Type)
    tel
      LHSState a -> TCM (LHSState a)
    forall (m :: * -> *) a.
    (PureTCM m, MonadError TCErr m, MonadTrace m,
     MonadFresh NameId m) =>
    LHSState a -> m (LHSState a)
    updateProblemRest (LHSState a -> TCM (LHSState a)) -> LHSState a -> TCM (LHSState a)
    forall a b. (a -> b) -> a -> b
    $ Lens' (Tele (Dom' Term Type)) (LHSState a)
    -> LensSet (Tele (Dom' Term Type)) (LHSState a)
    forall i o. Lens' i o -> LensSet i o
    set forall a. Lens' (Tele (Dom' Term Type)) (LHSState a)
    Lens' (Tele (Dom' Term Type)) (LHSState a)
    lhsTel Tele (Dom' Term Type)
    tel' (LHSState a -> LHSState a) -> LHSState a -> LHSState a
    forall a b. (a -> b) -> a -> b
    $ Lens' [ProblemEq] (LHSState a) -> LensSet [ProblemEq] (LHSState a)
    forall i o. Lens' i o -> LensSet i o
    set ((Problem a -> f (Problem a)) -> LHSState a -> f (LHSState a)
    forall a. Lens' (Problem a) (LHSState a)
    lhsProblem ((Problem a -> f (Problem a)) -> LHSState a -> f (LHSState a))
    -> (([ProblemEq] -> f [ProblemEq]) -> Problem a -> f (Problem a))
    -> ([ProblemEq] -> f [ProblemEq])
    -> LHSState a
    -> f (LHSState a)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ([ProblemEq] -> f [ProblemEq]) -> Problem a -> f (Problem a)
    forall a. Lens' [ProblemEq] (Problem a)
    problemEqs) [ProblemEq]
    eqs' LHSState a
    st

    -- | Update the user patterns in the given problem, simplifying equations
    --   between constructors where possible.
    updateProblemEqs
     :: [ProblemEq] -> TCM [ProblemEq]
    updateProblemEqs :: [ProblemEq] -> TCMT IO [ProblemEq]
    updateProblemEqs [ProblemEq]
    eqs = do
      [Char] -> Int -> TCMT IO Doc -> TCMT IO ()
    forall (m :: * -> *).
    MonadDebug m =>
    [Char] -> Int -> TCMT IO Doc -> m ()
    reportSDoc [Char]
    "tc.lhs.top" Int
    20 (TCMT IO Doc -> TCMT IO ()) -> TCMT IO Doc -> TCMT IO ()
    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
    "updateProblem: equations to update"
        , 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
    $ if [ProblemEq] -> Bool
    forall a. Null a => a -> Bool
    null [ProblemEq]
    eqs then TCMT IO Doc
    "(none)" else [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
    $ (ProblemEq -> TCMT IO Doc) -> [ProblemEq] -> [TCMT IO Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map ProblemEq -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM [ProblemEq]
    eqs
        ]

      [ProblemEq]
    eqs' <- [ProblemEq] -> TCMT IO [ProblemEq]
    updates [ProblemEq]
    eqs

      [Char] -> Int -> TCMT IO Doc -> TCMT IO ()
    forall (m :: * -> *).
    MonadDebug m =>
    [Char] -> Int -> TCMT IO Doc -> m ()
    reportSDoc [Char]
    "tc.lhs.top" Int
    20 (TCMT IO Doc -> TCMT IO ()) -> TCMT IO Doc -> TCMT IO ()
    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
    "updateProblem: new equations"
        , 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
    $ if [ProblemEq] -> Bool
    forall a. Null a => a -> Bool
    null [ProblemEq]
    eqs' then TCMT IO Doc
    "(none)" else [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
    $ (ProblemEq -> TCMT IO Doc) -> [ProblemEq] -> [TCMT IO Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map ProblemEq -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM [ProblemEq]
    eqs'
        ]

      [ProblemEq] -> TCMT IO [ProblemEq]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [ProblemEq]
    eqs'

      where

        updates :: [ProblemEq] -> TCM [ProblemEq]
        updates :: [ProblemEq] -> TCMT IO [ProblemEq]
    updates = [[ProblemEq]] -> [ProblemEq]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat ([[ProblemEq]] -> [ProblemEq])
    -> ([ProblemEq] -> TCMT IO [[ProblemEq]])
    -> [ProblemEq]
    -> TCMT IO [ProblemEq]
    forall (m :: * -> *) b c a.
    Functor m =>
    (b -> c) -> (a -> m b) -> a -> m c
    <.> (ProblemEq -> TCMT IO [ProblemEq])
    -> [ProblemEq] -> TCMT IO [[ProblemEq]]
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    traverse ProblemEq -> TCMT IO [ProblemEq]
    update

        update :: ProblemEq -> TCM [ProblemEq]
        update :: ProblemEq -> TCMT IO [ProblemEq]
    update eq :: ProblemEq
    eq@(ProblemEq A.WildP{} Term
    _ Dom' Term Type
    _) = [ProblemEq] -> TCMT IO [ProblemEq]
    forall (m :: * -> *) a. Monad m => a -> m a
    return []
        update eq :: ProblemEq
    eq@(ProblemEq p :: Pattern
    p@A.ProjP{} Term
    _ Dom' Term Type
    _) = TypeError -> TCMT IO [ProblemEq]
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCError m) =>
    TypeError -> m a
    typeError (TypeError -> TCMT IO [ProblemEq])
    -> TypeError -> TCMT IO [ProblemEq]
    forall a b. (a -> b) -> a -> b
    $ Pattern -> TypeError
    IllformedProjectionPattern Pattern
    p
        update eq :: ProblemEq
    eq@(ProblemEq p :: Pattern
    p@(A.AsP PatInfo
    info BindName
    x Pattern
    p') Term
    v Dom' Term Type
    a) =
          (Pattern -> Term -> Dom' Term Type -> ProblemEq
    ProblemEq (BindName -> Pattern
    forall e. BindName -> Pattern' e
    A.VarP BindName
    x) Term
    v Dom' Term Type
    a ProblemEq -> [ProblemEq] -> [ProblemEq]
    forall a. a -> [a] -> [a]
    :) ([ProblemEq] -> [ProblemEq])
    -> TCMT IO [ProblemEq] -> TCMT IO [ProblemEq]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ProblemEq -> TCMT IO [ProblemEq]
    update (Pattern -> Term -> Dom' Term Type -> ProblemEq
    ProblemEq Pattern
    p' Term
    v Dom' Term Type
    a)

        update eq :: ProblemEq
    eq@(ProblemEq p :: Pattern
    p@(A.AnnP PatInfo
    _ Expr
    _ A.WildP{}) Term
    v Dom' Term Type
    a) = [ProblemEq] -> TCMT IO [ProblemEq]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [ProblemEq
    eq]
        update eq :: ProblemEq
    eq@(ProblemEq p :: Pattern
    p@(A.AnnP PatInfo
    info Expr
    ty Pattern
    p') Term
    v Dom' Term Type
    a) =
          (Pattern -> Term -> Dom' Term Type -> ProblemEq
    ProblemEq (PatInfo -> Expr -> Pattern -> Pattern
    forall e. PatInfo -> e -> Pattern' e -> Pattern' e
    A.AnnP PatInfo
    info Expr
    ty (PatInfo -> Pattern
    forall e. PatInfo -> Pattern' e
    A.WildP PatInfo
    patNoRange)) Term
    v Dom' Term Type
    a ProblemEq -> [ProblemEq] -> [ProblemEq]
    forall a. a -> [a] -> [a]
    :) ([ProblemEq] -> [ProblemEq])
    -> TCMT IO [ProblemEq] -> TCMT IO [ProblemEq]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ProblemEq -> TCMT IO [ProblemEq]
    update (Pattern -> Term -> Dom' Term Type -> ProblemEq
    ProblemEq Pattern
    p' Term
    v Dom' Term Type
    a)

        update eq :: ProblemEq
    eq@(ProblemEq Pattern
    p Term
    v Dom' Term Type
    a) = Term -> TCMT IO Term
    forall a (m :: * -> *). (Reduce a, MonadReduce m) => a -> m a
    reduce Term
    v TCMT IO Term -> (Term -> TCMT IO Term) -> TCMT IO Term
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Term -> TCMT IO Term
    forall (m :: * -> *). HasBuiltins m => Term -> m Term
    constructorForm TCMT IO Term
    -> (Term -> TCMT IO [ProblemEq]) -> TCMT IO [ProblemEq]
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \case
          Con ConHead
    c ConInfo
    ci Elims
    es -> do
            let vs :: Args
    vs = Args -> Maybe Args -> Args
    forall a. a -> Maybe a -> a
    fromMaybe Args
    forall a. HasCallStack => a
    __IMPOSSIBLE__ (Maybe Args -> Args) -> Maybe Args -> Args
    forall a b. (a -> b) -> a -> b
    $ Elims -> Maybe Args
    forall a. [Elim' a] -> Maybe [Arg a]
    allApplyElims Elims
    es
            -- we should only simplify equations between fully applied constructors
            Maybe ((QName, Type, Args), Type)
    contype <- ConHead -> Type -> TCMT IO (Maybe ((QName, Type, Args), Type))
    forall (m :: * -> *).
    PureTCM m =>
    ConHead -> Type -> m (Maybe ((QName, Type, Args), Type))
    getFullyAppliedConType ConHead
    c (Type -> TCMT IO (Maybe ((QName, Type, Args), Type)))
    -> TCMT IO Type -> TCMT IO (Maybe ((QName, Type, Args), Type))
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< Type -> TCMT IO Type
    forall a (m :: * -> *). (Reduce a, MonadReduce m) => a -> m a
    reduce (Dom' Term Type -> Type
    forall t e. Dom' t e -> e
    unDom Dom' Term Type
    a)
            Maybe ((QName, Type, Args), Type)
    -> TCMT IO [ProblemEq]
    -> (((QName, Type, Args), Type) -> TCMT IO [ProblemEq])
    -> TCMT IO [ProblemEq]
    forall a b. Maybe a -> b -> (a -> b) -> b
    caseMaybe Maybe ((QName, Type, Args), Type)
    contype ([ProblemEq] -> TCMT IO [ProblemEq]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [ProblemEq
    eq]) ((((QName, Type, Args), Type) -> TCMT IO [ProblemEq])
     -> TCMT IO [ProblemEq])
    -> (((QName, Type, Args), Type) -> TCMT IO [ProblemEq])
    -> TCMT IO [ProblemEq]
    forall a b. (a -> b) -> a -> b
    $ \((QName
    d,Type
    _,Args
    pars),Type
    b) -> do
            TelV Tele (Dom' Term Type)
    ctel Type
    _ <- Type -> TCMT IO (TelV Type)
    forall (m :: * -> *). PureTCM m => Type -> m (TelV Type)
    telViewPath Type
    b

            -- Andrea 15/10/2020: propagate modality to constructor arguments
            let updMod :: Modality -> Modality
    updMod = Modality -> Modality -> Modality
    composeModality (Dom' Term Type -> Modality
    forall a. LensModality a => a -> Modality
    getModality Dom' Term Type
    a)
            Tele (Dom' Term Type)
    ctel <- Tele (Dom' Term Type) -> TCMT IO (Tele (Dom' Term Type))
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Tele (Dom' Term Type) -> TCMT IO (Tele (Dom' Term Type)))
    -> Tele (Dom' Term Type) -> TCMT IO (Tele (Dom' Term Type))
    forall a b. (a -> b) -> a -> b
    $ (Modality -> Modality) -> Dom' Term Type -> Dom' Term Type
    forall a. LensModality a => (Modality -> Modality) -> a -> a
    mapModality Modality -> Modality
    updMod (Dom' Term Type -> Dom' Term Type)
    -> Tele (Dom' Term Type) -> Tele (Dom' Term Type)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Tele (Dom' Term Type)
    ctel

            let bs :: [Dom' Term Type]
    bs = Tele (Dom' Term Type) -> [Term] -> [Dom' Term Type]
    instTel Tele (Dom' Term Type)
    ctel ((Arg Term -> Term) -> Args -> [Term]
    forall a b. (a -> b) -> [a] -> [b]
    map Arg Term -> Term
    forall e. Arg e -> e
    unArg Args
    vs)

            Pattern
    p <- Pattern -> TCMT IO Pattern
    forall (m :: * -> *).
    (MonadError TCErr m, MonadTCEnv m, ReadTCState m, HasBuiltins m) =>
    Pattern -> m Pattern
    expandLitPattern Pattern
    p
            case Pattern
    p of
              A.AsP{} -> TCMT IO [ProblemEq]
    forall a. HasCallStack => a
    __IMPOSSIBLE__
              A.AnnP{} -> TCMT IO [ProblemEq]
    forall a. HasCallStack => a
    __IMPOSSIBLE__
              A.ConP ConPatInfo
    cpi AmbiguousQName
    ambC [NamedArg Pattern]
    ps -> do
                (ConHead
    c',Type
    _) <- AmbiguousQName -> QName -> Args -> TCM (ConHead, Type)
    disambiguateConstructor AmbiguousQName
    ambC QName
    d Args
    pars

                -- Issue #3014: If the constructor is forced but the user wrote a
                -- different constructor,that's an error. We simply keep the
                -- problem equation, this will result in a proper error message later.
                if ConHead -> QName
    conName ConHead
    c QName -> QName -> Bool
    forall a. Eq a => a -> a -> Bool
    /= ConHead -> QName
    conName ConHead
    c' then [ProblemEq] -> TCMT IO [ProblemEq]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [ProblemEq
    eq] else do

                -- Insert implicit patterns
                [NamedArg Pattern]
    ps <- ExpandHidden
    -> [NamedArg Pattern]
    -> Tele (Dom' Term Type)
    -> TCMT IO [NamedArg Pattern]
    forall (m :: * -> *).
    (PureTCM m, MonadError TCErr m, MonadFresh NameId m,
     MonadTrace m) =>
    ExpandHidden
    -> [NamedArg Pattern]
    -> Tele (Dom' Term Type)
    -> m [NamedArg Pattern]
    insertImplicitPatterns ExpandHidden
    ExpandLast [NamedArg Pattern]
    ps Tele (Dom' Term Type)
    ctel
                [Char] -> Int -> TCMT IO Doc -> TCMT IO ()
    forall (m :: * -> *).
    MonadDebug m =>
    [Char] -> Int -> TCMT IO Doc -> m ()
    reportSDoc [Char]
    "tc.lhs.imp" Int
    20 (TCMT IO Doc -> TCMT IO ()) -> TCMT IO Doc -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $
                  TCMT IO Doc
    "insertImplicitPatternsT returned" 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 ((NamedArg Pattern -> TCMT IO Doc)
    -> [NamedArg Pattern] -> [TCMT IO Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map NamedArg Pattern -> TCMT IO Doc
    forall a (m :: * -> *).
    (ToConcrete a, Pretty (ConOfAbs a), MonadAbsToCon m) =>
    a -> m Doc
    prettyA [NamedArg Pattern]
    ps)

                -- Check argument count and hiding (not just count: #3074)
                let checkArgs :: [NamedArg Pattern] -> Args -> TCMT IO ()
    checkArgs [] [] = () -> TCMT IO ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
                    checkArgs (NamedArg Pattern
    p : [NamedArg Pattern]
    ps) (Arg Term
    v : Args
    vs)
                      | NamedArg Pattern -> Hiding
    forall a. LensHiding a => a -> Hiding
    getHiding NamedArg Pattern
    p Hiding -> Hiding -> Bool
    forall a. Eq a => a -> a -> Bool
    == Arg Term -> Hiding
    forall a. LensHiding a => a -> Hiding
    getHiding Arg Term
    v = [NamedArg Pattern] -> Args -> TCMT IO ()
    checkArgs [NamedArg Pattern]
    ps Args
    vs
                      | Bool
    otherwise                  = NamedArg Pattern -> TCMT IO () -> TCMT IO ()
    forall (m :: * -> *) x a.
    (MonadTrace m, HasRange x) =>
    x -> m a -> m a
    setCurrentRange NamedArg Pattern
    p (TCMT IO () -> TCMT IO ()) -> TCMT IO () -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ Doc -> TCMT IO ()
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCError m) =>
    Doc -> m a
    genericDocError (Doc -> TCMT IO ()) -> TCMT IO Doc -> TCMT IO ()
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< do
                          [TCMT IO Doc] -> TCMT IO Doc
    forall (m :: * -> *) (t :: * -> *).
    (Applicative m, Foldable t) =>
    t (m Doc) -> m Doc
    fsep ([TCMT IO Doc] -> TCMT IO Doc) -> [TCMT IO Doc] -> TCMT IO Doc
    forall a b. (a -> b) -> a -> b
    $ [Char] -> [TCMT IO Doc]
    forall (m :: * -> *). Applicative m => [Char] -> [m Doc]
    pwords ([Char]
    "Expected an " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Hiding -> [Char]
    forall {p}. IsString p => Hiding -> p
    which (Arg Term -> Hiding
    forall a. LensHiding a => a -> Hiding
    getHiding Arg Term
    v) [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    " argument " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++
                                         [Char]
    "instead of "  [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Hiding -> [Char]
    forall {p}. IsString p => Hiding -> p
    which (NamedArg Pattern -> Hiding
    forall a. LensHiding a => a -> Hiding
    getHiding NamedArg Pattern
    p) [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    " argument") [TCMT IO Doc] -> [TCMT IO Doc] -> [TCMT IO Doc]
    forall a. [a] -> [a] -> [a]
    ++
                                 [ NamedArg Pattern -> TCMT IO Doc
    forall a (m :: * -> *).
    (ToConcrete a, Pretty (ConOfAbs a), MonadAbsToCon m) =>
    a -> m Doc
    prettyA NamedArg Pattern
    p ]
                      where which :: Hiding -> p
    which Hiding
    NotHidden  = p
    "explicit"
                            which Hiding
    Hidden     = p
    "implicit"
                            which Instance{} = p
    "instance"
                    checkArgs [] Args
    vs = Doc -> TCMT IO ()
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCError m) =>
    Doc -> m a
    genericDocError (Doc -> TCMT IO ()) -> TCMT IO Doc -> TCMT IO ()
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< do
                        [TCMT IO Doc] -> TCMT IO Doc
    forall (m :: * -> *) (t :: * -> *).
    (Applicative m, Foldable t) =>
    t (m Doc) -> m Doc
    fsep ([TCMT IO Doc] -> TCMT IO Doc) -> [TCMT IO Doc] -> TCMT IO Doc
    forall a b. (a -> b) -> a -> b
    $ [Char] -> [TCMT IO Doc]
    forall (m :: * -> *). Applicative m => [Char] -> [m Doc]
    pwords [Char]
    "Too few arguments to constructor" [TCMT IO Doc] -> [TCMT IO Doc] -> [TCMT IO Doc]
    forall a. [a] -> [a] -> [a]
    ++ [ConHead -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM ConHead
    c TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall a. Semigroup a => a -> a -> a
    <> TCMT IO Doc
    ","] [TCMT IO Doc] -> [TCMT IO Doc] -> [TCMT IO Doc]
    forall a. [a] -> [a] -> [a]
    ++
                               [Char] -> [TCMT IO Doc]
    forall (m :: * -> *). Applicative m => [Char] -> [m Doc]
    pwords ([Char]
    "expected " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Int -> [Char]
    forall a. Show a => a -> [Char]
    show Int
    n [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    " more explicit "  [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    arguments)
                      where n :: Int
    n = Args -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length ((Arg Term -> Bool) -> Args -> Args
    forall a. (a -> Bool) -> [a] -> [a]
    filter Arg Term -> Bool
    forall a. LensHiding a => a -> Bool
    visible Args
    vs)
                            arguments :: [Char]
    arguments | Int
    n Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    1    = [Char]
    "argument"
                                      | Bool
    otherwise = [Char]
    "arguments"
                    checkArgs (NamedArg Pattern
    p : [NamedArg Pattern]
    _) [] = NamedArg Pattern -> TCMT IO () -> TCMT IO ()
    forall (m :: * -> *) x a.
    (MonadTrace m, HasRange x) =>
    x -> m a -> m a
    setCurrentRange NamedArg Pattern
    p (TCMT IO () -> TCMT IO ()) -> TCMT IO () -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ Doc -> TCMT IO ()
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCError m) =>
    Doc -> m a
    genericDocError (Doc -> TCMT IO ()) -> TCMT IO Doc -> TCMT IO ()
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< do
                      [TCMT IO Doc] -> TCMT IO Doc
    forall (m :: * -> *) (t :: * -> *).
    (Applicative m, Foldable t) =>
    t (m Doc) -> m Doc
    fsep ([TCMT IO Doc] -> TCMT IO Doc) -> [TCMT IO Doc] -> TCMT IO Doc
    forall a b. (a -> b) -> a -> b
    $ [Char] -> [TCMT IO Doc]
    forall (m :: * -> *). Applicative m => [Char] -> [m Doc]
    pwords [Char]
    "Too many arguments to constructor" [TCMT IO Doc] -> [TCMT IO Doc] -> [TCMT IO Doc]
    forall a. [a] -> [a] -> [a]
    ++ [ConHead -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM ConHead
    c]
                [NamedArg Pattern] -> Args -> TCMT IO ()
    checkArgs [NamedArg Pattern]
    ps Args
    vs

                [ProblemEq] -> TCMT IO [ProblemEq]
    updates ([ProblemEq] -> TCMT IO [ProblemEq])
    -> [ProblemEq] -> TCMT IO [ProblemEq]
    forall a b. (a -> b) -> a -> b
    $ (Pattern -> Term -> Dom' Term Type -> ProblemEq)
    -> [Pattern] -> [Term] -> [Dom' Term Type] -> [ProblemEq]
    forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
    zipWith3 Pattern -> Term -> Dom' Term Type -> ProblemEq
    ProblemEq ((NamedArg Pattern -> Pattern) -> [NamedArg Pattern] -> [Pattern]
    forall a b. (a -> b) -> [a] -> [b]
    map NamedArg Pattern -> Pattern
    forall a. NamedArg a -> a
    namedArg [NamedArg Pattern]
    ps) ((Arg Term -> Term) -> Args -> [Term]
    forall a b. (a -> b) -> [a] -> [b]
    map Arg Term -> Term
    forall e. Arg e -> e
    unArg Args
    vs) [Dom' Term Type]
    bs

              A.RecP PatInfo
    pi [FieldAssignment' Pattern]
    fs -> do
                [Arg QName]
    axs <- (Dom' Term QName -> Arg QName) -> [Dom' Term QName] -> [Arg QName]
    forall a b. (a -> b) -> [a] -> [b]
    map Dom' Term QName -> Arg QName
    forall t a. Dom' t a -> Arg a
    argFromDom ([Dom' Term QName] -> [Arg QName])
    -> (Definition -> [Dom' Term QName]) -> Definition -> [Arg QName]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Defn -> [Dom' Term QName]
    recFields (Defn -> [Dom' Term QName])
    -> (Definition -> Defn) -> Definition -> [Dom' Term QName]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Definition -> Defn
    theDef (Definition -> [Arg QName])
    -> TCMT IO Definition -> TCMT IO [Arg QName]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> QName -> TCMT IO Definition
    forall (m :: * -> *). HasConstInfo m => QName -> m Definition
    getConstInfo QName
    d

                -- Andreas, 2018-09-06, issue #3122.
                -- Associate the concrete record field names used in the record pattern
                -- to their counterpart in the record type definition.
                [Name] -> [QName] -> TCMT IO ()
    disambiguateRecordFields ((FieldAssignment' Pattern -> Name)
    -> [FieldAssignment' Pattern] -> [Name]
    forall a b. (a -> b) -> [a] -> [b]
    map FieldAssignment' Pattern -> Name
    forall a. FieldAssignment' a -> Name
    _nameFieldA [FieldAssignment' Pattern]
    fs) ((Arg QName -> QName) -> [Arg QName] -> [QName]
    forall a b. (a -> b) -> [a] -> [b]
    map Arg QName -> QName
    forall e. Arg e -> e
    unArg [Arg QName]
    axs)

                let cxs :: [Arg Name]
    cxs = (Arg QName -> Arg Name) -> [Arg QName] -> [Arg Name]
    forall a b. (a -> b) -> [a] -> [b]
    map ((QName -> Name) -> Arg QName -> Arg Name
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (Name -> Name
    nameConcrete (Name -> Name) -> (QName -> Name) -> QName -> Name
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . QName -> Name
    qnameName)) [Arg QName]
    axs

                -- In fs omitted explicit fields are replaced by underscores,
                -- and the fields are put in the correct order.
                [NamedArg Pattern]
    ps <- QName
    -> (Name -> Pattern)
    -> [FieldAssignment' Pattern]
    -> [Arg Name]
    -> TCMT IO [NamedArg Pattern]
    forall a.
    HasRange a =>
    QName
    -> (Name -> a)
    -> [FieldAssignment' a]
    -> [Arg Name]
    -> TCM [NamedArg a]
    insertMissingFieldsFail QName
    d (Pattern -> Name -> Pattern
    forall a b. a -> b -> a
    const (Pattern -> Name -> Pattern) -> Pattern -> Name -> Pattern
    forall a b. (a -> b) -> a -> b
    $ PatInfo -> Pattern
    forall e. PatInfo -> Pattern' e
    A.WildP PatInfo
    patNoRange) [FieldAssignment' Pattern]
    fs [Arg Name]
    cxs

                -- We also need to insert missing implicit or instance fields.
                [NamedArg Pattern]
    ps <- ExpandHidden
    -> [NamedArg Pattern]
    -> Tele (Dom' Term Type)
    -> TCMT IO [NamedArg Pattern]
    forall (m :: * -> *).
    (PureTCM m, MonadError TCErr m, MonadFresh NameId m,
     MonadTrace m) =>
    ExpandHidden
    -> [NamedArg Pattern]
    -> Tele (Dom' Term Type)
    -> m [NamedArg Pattern]
    insertImplicitPatterns ExpandHidden
    ExpandLast [NamedArg Pattern]
    ps Tele (Dom' Term Type)
    ctel

                let eqs :: [ProblemEq]
    eqs = (Pattern -> Term -> Dom' Term Type -> ProblemEq)
    -> [Pattern] -> [Term] -> [Dom' Term Type] -> [ProblemEq]
    forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
    zipWith3 Pattern -> Term -> Dom' Term Type -> ProblemEq
    ProblemEq ((NamedArg Pattern -> Pattern) -> [NamedArg Pattern] -> [Pattern]
    forall a b. (a -> b) -> [a] -> [b]
    map NamedArg Pattern -> Pattern
    forall a. NamedArg a -> a
    namedArg [NamedArg Pattern]
    ps) ((Arg Term -> Term) -> Args -> [Term]
    forall a b. (a -> b) -> [a] -> [b]
    map Arg Term -> Term
    forall e. Arg e -> e
    unArg Args
    vs) [Dom' Term Type]
    bs
                [ProblemEq] -> TCMT IO [ProblemEq]
    updates [ProblemEq]
    eqs

              Pattern
    _ -> [ProblemEq] -> TCMT IO [ProblemEq]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [ProblemEq
    eq]

          Lit Literal
    l | A.LitP PatInfo
    _ Literal
    l' <- Pattern
    p , Literal
    l Literal -> Literal -> Bool
    forall a. Eq a => a -> a -> Bool
    == Literal
    l' -> [ProblemEq] -> TCMT IO [ProblemEq]
    forall (m :: * -> *) a. Monad m => a -> m a
    return []

          Term
    _ | A.EqualP{} <- Pattern
    p -> do
            Term
    itisone <- TCMT IO Term -> TCMT IO Term
    forall (tcm :: * -> *) a. MonadTCM tcm => TCM a -> tcm a
    liftTCM TCMT IO Term
    forall (m :: * -> *).
    (HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
    m Term
    primItIsOne
            TCMT IO Bool
    -> TCMT IO [ProblemEq]
    -> TCMT IO [ProblemEq]
    -> TCMT IO [ProblemEq]
    forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
    ifM (TCMT IO () -> TCMT IO Bool
    forall (m :: * -> *).
    (MonadConstraint m, MonadWarning m, MonadError TCErr m,
     MonadFresh ProblemId m) =>
    m () -> m Bool
    tryConversion (TCMT IO () -> TCMT IO Bool) -> TCMT IO () -> TCMT IO Bool
    forall a b. (a -> b) -> a -> b
    $ Type -> Term -> Term -> TCMT IO ()
    forall (m :: * -> *).
    MonadConversion m =>
    Type -> Term -> Term -> m ()
    equalTerm (Dom' Term Type -> Type
    forall t e. Dom' t e -> e
    unDom Dom' Term Type
    a) Term
    v Term
    itisone) ([ProblemEq] -> TCMT IO [ProblemEq]
    forall (m :: * -> *) a. Monad m => a -> m a
    return []) ([ProblemEq] -> TCMT IO [ProblemEq]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [ProblemEq
    eq])

          Term
    _ -> [ProblemEq] -> TCMT IO [ProblemEq]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [ProblemEq
    eq]

        instTel :: Telescope -> [Term] -> [Dom Type]
        instTel :: Tele (Dom' Term Type) -> [Term] -> [Dom' Term Type]
    instTel Tele (Dom' Term Type)
    EmptyTel [Term]
    _                   = []
        instTel (ExtendTel Dom' Term Type
    arg Abs (Tele (Dom' Term Type))
    tel) (Term
    u : [Term]
    us) = Dom' Term Type
    arg Dom' Term Type -> [Dom' Term Type] -> [Dom' Term Type]
    forall a. a -> [a] -> [a]
    : Tele (Dom' Term Type) -> [Term] -> [Dom' Term Type]
    instTel (Abs (Tele (Dom' Term Type))
    -> SubstArg (Tele (Dom' Term Type)) -> Tele (Dom' Term Type)
    forall a. Subst a => Abs a -> SubstArg a -> a
    absApp Abs (Tele (Dom' Term Type))
    tel Term
    SubstArg (Tele (Dom' Term Type))
    u) [Term]
    us
        instTel ExtendTel{} []               = [Dom' Term Type]
    forall a. HasCallStack => a
    __IMPOSSIBLE__

    -- | Check if a problem is solved.
    --   That is, if the patterns are all variables,
    --   and there is no 'problemRest'.
    isSolvedProblem :: Problem a -> Bool
    isSolvedProblem :: forall a. Problem a -> Bool
    isSolvedProblem Problem a
    problem = [NamedArg Pattern] -> Bool
    forall a. Null a => a -> Bool
    null (Problem a
    problem Problem a
    -> Lens' [NamedArg Pattern] (Problem a) -> [NamedArg Pattern]
    forall o i. o -> Lens' i o -> i
    ^. forall a. Lens' [NamedArg Pattern] (Problem a)
    Lens' [NamedArg Pattern] (Problem a)
    problemRestPats) Bool -> Bool -> Bool
    &&
      Problem a -> Bool
    forall a. Problem a -> Bool
    problemAllVariables Problem a
    problem

    -- | Check if a problem consists only of variable patterns.
    --   (Includes the 'problemRest').
    problemAllVariables :: Problem a -> Bool
    problemAllVariables :: forall a. Problem a -> Bool
    problemAllVariables Problem a
    problem =
        (Pattern -> Bool) -> [Pattern] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all Pattern -> Bool
    forall {e}. Pattern' e -> Bool
    isSolved ([Pattern] -> Bool) -> [Pattern] -> Bool
    forall a b. (a -> b) -> a -> b
    $
          (NamedArg Pattern -> Pattern) -> [NamedArg Pattern] -> [Pattern]
    forall a b. (a -> b) -> [a] -> [b]
    map NamedArg Pattern -> Pattern
    forall a. NamedArg a -> a
    namedArg (Problem a
    problem Problem a
    -> Lens' [NamedArg Pattern] (Problem a) -> [NamedArg Pattern]
    forall o i. o -> Lens' i o -> i
    ^. forall a. Lens' [NamedArg Pattern] (Problem a)
    Lens' [NamedArg Pattern] (Problem a)
    problemRestPats) [Pattern] -> [Pattern] -> [Pattern]
    forall a. [a] -> [a] -> [a]
    ++ Problem a -> [Pattern]
    forall a. Problem a -> [Pattern]
    problemInPats Problem a
    problem
      where
        -- need further splitting:
        isSolved :: Pattern' e -> Bool
    isSolved A.ConP{}        = Bool
    False
        isSolved A.LitP{}        = Bool
    False
        isSolved A.RecP{}        = Bool
    False  -- record pattern
        -- solved:
        isSolved A.VarP{}        = Bool
    True
        isSolved A.WildP{}       = Bool
    True
        isSolved A.DotP{}        = Bool
    True
        isSolved A.AbsurdP{}     = Bool
    True
        -- recursive cases
        isSolved (A.AsP PatInfo
    _ BindName
    _ Pattern' e
    p)   = Pattern' e -> Bool
    isSolved Pattern' e
    p
        isSolved (A.AnnP PatInfo
    _ e
    _ Pattern' e
    p)  = Pattern' e -> Bool
    isSolved Pattern' e
    p
        -- impossible:
        isSolved A.ProjP{}       = Bool
    forall a. HasCallStack => a
    __IMPOSSIBLE__
        isSolved A.DefP{}        = Bool
    forall a. HasCallStack => a
    __IMPOSSIBLE__
        isSolved A.PatternSynP{} = Bool
    forall a. HasCallStack => a
    __IMPOSSIBLE__  -- expanded before
        isSolved A.EqualP{}      = Bool
    False -- __IMPOSSIBLE__
        isSolved A.WithP{}       = Bool
    forall a. HasCallStack => a
    __IMPOSSIBLE__

    -- | For each user-defined pattern variable in the 'Problem', check
    -- that the corresponding data type (if any) does not contain a
    -- constructor of the same name (which is not in scope); this
    -- \"shadowing\" could indicate an error, and is not allowed.
    --
    -- Precondition: The problem has to be solved.

    noShadowingOfConstructors :: ProblemEq -> TCM ()
    noShadowingOfConstructors :: ProblemEq -> TCMT IO ()
    noShadowingOfConstructors problem :: ProblemEq
    problem@(ProblemEq Pattern
    p Term
    _ (Dom{domInfo :: forall t e. Dom' t e -> ArgInfo
    domInfo = ArgInfo
    info, unDom :: forall t e. Dom' t e -> e
    unDom = El Sort' Term
    _ Term
    a})) =
      case Pattern
    p of
       A.WildP       {} -> () -> TCMT IO ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
       A.AbsurdP     {} -> () -> TCMT IO ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
       A.DotP        {} -> () -> TCMT IO ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
       A.EqualP      {} -> () -> TCMT IO ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
       A.AsP PatInfo
    _ BindName
    _ Pattern
    p      -> ProblemEq -> TCMT IO ()
    noShadowingOfConstructors (ProblemEq -> TCMT IO ()) -> ProblemEq -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ ProblemEq
    problem { problemInPat :: Pattern
    problemInPat = Pattern
    p }
       A.AnnP PatInfo
    _ Expr
    _ Pattern
    p     -> ProblemEq -> TCMT IO ()
    noShadowingOfConstructors (ProblemEq -> TCMT IO ()) -> ProblemEq -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ ProblemEq
    problem { problemInPat :: Pattern
    problemInPat = Pattern
    p }
       A.ConP        {} -> TCMT IO ()
    forall a. HasCallStack => a
    __IMPOSSIBLE__
       A.RecP        {} -> TCMT IO ()
    forall a. HasCallStack => a
    __IMPOSSIBLE__
       A.ProjP       {} -> TCMT IO ()
    forall a. HasCallStack => a
    __IMPOSSIBLE__
       A.DefP        {} -> TCMT IO ()
    forall a. HasCallStack => a
    __IMPOSSIBLE__
       A.LitP        {} -> TCMT IO ()
    forall a. HasCallStack => a
    __IMPOSSIBLE__
       A.PatternSynP {} -> TCMT IO ()
    forall a. HasCallStack => a
    __IMPOSSIBLE__
       A.WithP       {} -> TCMT IO ()
    forall a. HasCallStack => a
    __IMPOSSIBLE__
       -- Andreas, 2017-12-01, issue #2859.
       -- Due to parameter refinement, there can be (invisible) variable patterns from module
       -- parameters that shadow constructors.
       -- Thus, only complain about user written variable that shadow constructors.
       A.VarP A.BindName{unBind :: BindName -> Name
    unBind = Name
    x} -> Bool -> TCMT IO () -> TCMT IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (ArgInfo -> Origin
    forall a. LensOrigin a => a -> Origin
    getOrigin ArgInfo
    info Origin -> Origin -> Bool
    forall a. Eq a => a -> a -> Bool
    == Origin
    UserWritten) (TCMT IO () -> TCMT IO ()) -> TCMT IO () -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ do
        [Char] -> Int -> TCMT IO Doc -> TCMT IO ()
    forall (m :: * -> *).
    MonadDebug m =>
    [Char] -> Int -> TCMT IO Doc -> m ()
    reportSDoc [Char]
    "tc.lhs.shadow" Int
    30 (TCMT IO Doc -> TCMT IO ()) -> TCMT IO Doc -> TCMT IO ()
    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
          [ [Char] -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => [Char] -> m Doc
    text ([Char] -> TCMT IO Doc) -> [Char] -> TCMT IO Doc
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "checking whether pattern variable " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Name -> [Char]
    forall a. Pretty a => a -> [Char]
    prettyShow Name
    x [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    " shadows a constructor"
          , 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
    "type of variable =" 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
          , 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
    "position of variable =" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> ([Char] -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => [Char] -> m Doc
    text ([Char] -> TCMT IO Doc)
    -> (Range' SrcFile -> [Char]) -> Range' SrcFile -> TCMT IO Doc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Range' SrcFile -> [Char]
    forall a. Show a => a -> [Char]
    show) (Name -> Range' SrcFile
    forall a. HasRange a => a -> Range' SrcFile
    getRange Name
    x)
          ]
        [Char] -> Int -> TCMT IO Doc -> TCMT IO ()
    forall (m :: * -> *).
    MonadDebug m =>
    [Char] -> Int -> TCMT IO Doc -> m ()
    reportSDoc [Char]
    "tc.lhs.shadow" Int
    70 (TCMT IO Doc -> TCMT IO ()) -> TCMT IO Doc -> TCMT IO ()
    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
    "a =" 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
        Term
    a <- Term -> TCMT IO Term
    forall a (m :: * -> *). (Reduce a, MonadReduce m) => a -> m a
    reduce Term
    a
        case Term
    a of
          Def QName
    t Elims
    _ -> do
            Defn
    d <- Definition -> Defn
    theDef (Definition -> Defn) -> TCMT IO Definition -> TCMT IO Defn
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> QName -> TCMT IO Definition
    forall (m :: * -> *). HasConstInfo m => QName -> m Definition
    getConstInfo QName
    t
            case Defn
    d of
              Datatype { dataCons :: Defn -> [QName]
    dataCons = [QName]
    cs } -> do
                case (QName -> Bool) -> [QName] -> [QName]
    forall a. (a -> Bool) -> [a] -> [a]
    filter ((Name -> Name
    A.nameConcrete Name
    x Name -> Name -> Bool
    forall a. Eq a => a -> a -> Bool
    ==) (Name -> Bool) -> (QName -> Name) -> QName -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Name -> Name
    A.nameConcrete (Name -> Name) -> (QName -> Name) -> QName -> Name
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . QName -> Name
    A.qnameName) [QName]
    cs of
                  []      -> () -> TCMT IO ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
                  (QName
    c : [QName]
    _) -> Name -> TCMT IO () -> TCMT IO ()
    forall (m :: * -> *) x a.
    (MonadTrace m, HasRange x) =>
    x -> m a -> m a
    setCurrentRange Name
    x (TCMT IO () -> TCMT IO ()) -> TCMT IO () -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $
                    TypeError -> TCMT IO ()
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCError m) =>
    TypeError -> m a
    typeError (TypeError -> TCMT IO ()) -> TypeError -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ Name -> QName -> TypeError
    PatternShadowsConstructor (Name -> Name
    nameConcrete Name
    x) QName
    c
              AbstractDefn{} -> () -> TCMT IO ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
                -- Abstract constructors cannot be brought into scope,
                -- even by a bigger import list.
                -- Thus, they cannot be confused with variables.
                -- Alternatively, we could do getConstInfo in ignoreAbstractMode,
                -- then Agda would complain if a variable shadowed an abstract constructor.
              Axiom       {} -> () -> TCMT IO ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
              DataOrRecSig{} -> () -> TCMT IO ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
              Function    {} -> () -> TCMT IO ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
              Record      {} -> () -> TCMT IO ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
              Constructor {} -> TCMT IO ()
    forall a. HasCallStack => a
    __IMPOSSIBLE__
              GeneralizableVar{} -> TCMT IO ()
    forall a. HasCallStack => a
    __IMPOSSIBLE__
              -- TODO: in the future some stuck primitives might allow constructors
              Primitive   {} -> () -> TCMT IO ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
              PrimitiveSort{} -> () -> TCMT IO ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
          Var   {} -> () -> TCMT IO ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
          Pi    {} -> () -> TCMT IO ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
          Sort  {} -> () -> TCMT IO ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
          MetaV {} -> () -> TCMT IO ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
          -- TODO: If the type is a meta-variable, should the test be
          -- postponed? If there is a problem, then it will be caught when
          -- the completed module is type checked, so it is safe to skip
          -- the test here. However, users may be annoyed if they get an
          -- error in code which has already passed the type checker.
          Lam   {} -> TCMT IO ()
    forall a. HasCallStack => a
    __IMPOSSIBLE__
          Lit   {} -> TCMT IO ()
    forall a. HasCallStack => a
    __IMPOSSIBLE__
          Level {} -> TCMT IO ()
    forall a. HasCallStack => a
    __IMPOSSIBLE__
          Con   {} -> TCMT IO ()
    forall a. HasCallStack => a
    __IMPOSSIBLE__
          DontCare{} -> TCMT IO ()
    forall a. HasCallStack => a
    __IMPOSSIBLE__
          Dummy [Char]
    s Elims
    _  -> [Char] -> TCMT IO ()
    forall (m :: * -> *) a.
    (HasCallStack, MonadDebug m) =>
    [Char] -> m a
    __IMPOSSIBLE_VERBOSE__ [Char]
    s

    -- | Check that a dot pattern matches it's instantiation.
    checkDotPattern :: DotPattern -> TCM ()
    checkDotPattern :: DotPattern -> TCMT IO ()
    checkDotPattern (Dot Expr
    e Term
    v (Dom{domInfo :: forall t e. Dom' t e -> ArgInfo
    domInfo = ArgInfo
    info, unDom :: forall t e. Dom' t e -> e
    unDom = Type
    a})) =
      Call -> TCMT IO () -> TCMT IO ()
    forall (m :: * -> *) a. MonadTrace m => Call -> m a -> m a
    traceCall (Expr -> Term -> Call
    CheckDotPattern Expr
    e Term
    v) (TCMT IO () -> TCMT IO ()) -> TCMT IO () -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ do
      [Char] -> Int -> TCMT IO Doc -> TCMT IO ()
    forall (m :: * -> *).
    MonadDebug m =>
    [Char] -> Int -> TCMT IO Doc -> m ()
    reportSDoc [Char]
    "tc.lhs.dot" Int
    15 (TCMT IO Doc -> TCMT IO ()) -> TCMT IO Doc -> TCMT IO ()
    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
    "checking dot pattern"
            , 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
    $ Expr -> TCMT IO Doc
    forall a (m :: * -> *).
    (ToConcrete a, Pretty (ConOfAbs a), MonadAbsToCon m) =>
    a -> m Doc
    prettyA Expr
    e
            , 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 -> 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
    ":" 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
            ]
      ArgInfo -> TCMT IO () -> TCMT IO ()
    forall (tcm :: * -> *) m a.
    (MonadTCEnv tcm, LensModality m) =>
    m -> tcm a -> tcm a
    applyModalityToContext ArgInfo
    info (TCMT IO () -> TCMT IO ()) -> TCMT IO () -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ do
        Term
    u <- Expr -> Type -> TCMT IO Term
    checkExpr Expr
    e Type
    a
        [Char] -> Int -> TCMT IO Doc -> TCMT IO ()
    forall (m :: * -> *).
    MonadDebug m =>
    [Char] -> Int -> TCMT IO Doc -> m ()
    reportSDoc [Char]
    "tc.lhs.dot" Int
    50 (TCMT IO Doc -> TCMT IO ()) -> TCMT IO Doc -> TCMT IO ()
    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
    "equalTerm"
              , 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
    $ Type -> TCMT IO Doc
    forall (m :: * -> *) a. (Applicative m, Pretty a) => a -> m Doc
    pretty Type
    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
    $ Term -> TCMT IO Doc
    forall (m :: * -> *) a. (Applicative m, Pretty a) => a -> m Doc
    pretty Term
    u
              , 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 (m :: * -> *) a. (Applicative m, Pretty a) => a -> m Doc
    pretty Term
    v
              ]
        Type -> Term -> Term -> TCMT IO ()
    forall (m :: * -> *).
    MonadConversion m =>
    Type -> Term -> Term -> m ()
    equalTerm Type
    a Term
    u Term
    v

    checkAbsurdPattern :: AbsurdPattern -> TCM ()
    checkAbsurdPattern :: AbsurdPattern -> TCMT IO ()
    checkAbsurdPattern (Absurd Range' SrcFile
    r Type
    a) = Range' SrcFile -> Type -> TCMT IO ()
    ensureEmptyType Range' SrcFile
    r Type
    a

    checkAnnotationPattern :: AnnotationPattern -> TCM ()
    checkAnnotationPattern :: AnnotationPattern -> TCMT IO ()
    checkAnnotationPattern (Ann Expr
    t Type
    a) = do
      [Char] -> Int -> TCMT IO Doc -> TCMT IO ()
    forall (m :: * -> *).
    MonadDebug m =>
    [Char] -> Int -> TCMT IO Doc -> m ()
    reportSDoc [Char]
    "tc.lhs.ann" Int
    15 (TCMT IO Doc -> TCMT IO ()) -> TCMT IO Doc -> TCMT IO ()
    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
    "checking type annotation in pattern"
            , 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
    $ Expr -> TCMT IO Doc
    forall a (m :: * -> *).
    (ToConcrete a, Pretty (ConOfAbs a), MonadAbsToCon m) =>
    a -> m Doc
    prettyA Expr
    t
            , 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 -> 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
            ]
      Type
    b <- Expr -> TCMT IO Type
    isType_ Expr
    t
      Type -> Type -> TCMT IO ()
    forall (m :: * -> *). MonadConversion m => Type -> Type -> m ()
    equalType Type
    a Type
    b

    -- | After splitting is complete, we transfer the origins
    --   We also transfer the locations of absurd patterns, since these haven't
    --   been introduced yet in the internal pattern.
    transferOrigins :: [NamedArg A.Pattern]
                    -> [NamedArg DeBruijnPattern]
                    -> TCM [NamedArg DeBruijnPattern]
    transferOrigins :: [NamedArg Pattern]
    -> [NamedArg DeBruijnPattern] -> TCM [NamedArg DeBruijnPattern]
    transferOrigins [NamedArg Pattern]
    ps [NamedArg DeBruijnPattern]
    qs = do
      [Char] -> Int -> TCMT IO Doc -> TCMT IO ()
    forall (m :: * -> *).
    MonadDebug m =>
    [Char] -> Int -> TCMT IO Doc -> m ()
    reportSDoc [Char]
    "tc.lhs.origin" Int
    40 (TCMT IO Doc -> TCMT IO ()) -> TCMT IO Doc -> TCMT IO ()
    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
    "transferOrigins"
        , 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
    "ps  =   " TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> [NamedArg Pattern] -> TCMT IO Doc
    forall a (m :: * -> *).
    (ToConcrete a, Pretty (ConOfAbs a), MonadAbsToCon m) =>
    a -> m Doc
    prettyA [NamedArg Pattern]
    ps
          , TCMT IO Doc
    "qs  =   " TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> [NamedArg DeBruijnPattern] -> TCMT IO Doc
    forall (m :: * -> *) a. (Applicative m, Pretty a) => a -> m Doc
    pretty [NamedArg DeBruijnPattern]
    qs
          ]
        ]
      [NamedArg Pattern]
    -> [NamedArg DeBruijnPattern] -> TCM [NamedArg DeBruijnPattern]
    transfers [NamedArg Pattern]
    ps [NamedArg DeBruijnPattern]
    qs

      where
        transfers :: [NamedArg A.Pattern]
                  -> [NamedArg DeBruijnPattern]
                  -> TCM [NamedArg DeBruijnPattern]
        transfers :: [NamedArg Pattern]
    -> [NamedArg DeBruijnPattern] -> TCM [NamedArg DeBruijnPattern]
    transfers [] [NamedArg DeBruijnPattern]
    qs
          | (NamedArg DeBruijnPattern -> Bool)
    -> [NamedArg DeBruijnPattern] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all NamedArg DeBruijnPattern -> Bool
    forall a. LensHiding a => a -> Bool
    notVisible [NamedArg DeBruijnPattern]
    qs = [NamedArg DeBruijnPattern] -> TCM [NamedArg DeBruijnPattern]
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([NamedArg DeBruijnPattern] -> TCM [NamedArg DeBruijnPattern])
    -> [NamedArg DeBruijnPattern] -> TCM [NamedArg DeBruijnPattern]
    forall a b. (a -> b) -> a -> b
    $ (NamedArg DeBruijnPattern -> NamedArg DeBruijnPattern)
    -> [NamedArg DeBruijnPattern] -> [NamedArg DeBruijnPattern]
    forall a b. (a -> b) -> [a] -> [b]
    map (Origin -> NamedArg DeBruijnPattern -> NamedArg DeBruijnPattern
    forall a. LensOrigin a => Origin -> a -> a
    setOrigin Origin
    Inserted) [NamedArg DeBruijnPattern]
    qs
          | Bool
    otherwise         = TCM [NamedArg DeBruijnPattern]
    forall a. HasCallStack => a
    __IMPOSSIBLE__
        transfers (NamedArg Pattern
    p : [NamedArg Pattern]
    ps) [] = TCM [NamedArg DeBruijnPattern]
    forall a. HasCallStack => a
    __IMPOSSIBLE__
        transfers (NamedArg Pattern
    p : [NamedArg Pattern]
    ps) (NamedArg DeBruijnPattern
    q : [NamedArg DeBruijnPattern]
    qs)
          | NamedArg Pattern -> NamedArg DeBruijnPattern -> Bool
    matchingArgs NamedArg Pattern
    p NamedArg DeBruijnPattern
    q = do
              NamedArg DeBruijnPattern
    q' <- (Maybe (NameOf (NamedArg DeBruijnPattern))
     -> Maybe (NameOf (NamedArg DeBruijnPattern)))
    -> NamedArg DeBruijnPattern -> NamedArg DeBruijnPattern
    forall a.
    LensNamed a =>
    (Maybe (NameOf a) -> Maybe (NameOf a)) -> a -> a
    mapNameOf ((Maybe NamedName -> Maybe NamedName)
    -> (NamedName -> Maybe NamedName -> Maybe NamedName)
    -> Maybe NamedName
    -> Maybe NamedName
    -> Maybe NamedName
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Maybe NamedName -> Maybe NamedName
    forall a. a -> a
    id (Maybe NamedName -> Maybe NamedName -> Maybe NamedName
    forall a b. a -> b -> a
    const (Maybe NamedName -> Maybe NamedName -> Maybe NamedName)
    -> (NamedName -> Maybe NamedName)
    -> NamedName
    -> Maybe NamedName
    -> Maybe NamedName
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . NamedName -> Maybe NamedName
    forall a. a -> Maybe a
    Just) (Maybe NamedName -> Maybe NamedName -> Maybe NamedName)
    -> Maybe NamedName -> Maybe NamedName -> Maybe NamedName
    forall a b. (a -> b) -> a -> b
    $ NamedArg Pattern -> Maybe (NameOf (NamedArg Pattern))
    forall a. LensNamed a => a -> Maybe (NameOf a)
    getNameOf NamedArg Pattern
    p) -- take NamedName from p if present
                  (NamedArg DeBruijnPattern -> NamedArg DeBruijnPattern)
    -> (NamedArg DeBruijnPattern -> NamedArg DeBruijnPattern)
    -> NamedArg DeBruijnPattern
    -> NamedArg DeBruijnPattern
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Origin -> NamedArg DeBruijnPattern -> NamedArg DeBruijnPattern
    forall a. LensOrigin a => Origin -> a -> a
    setOrigin (NamedArg Pattern -> Origin
    forall a. LensOrigin a => a -> Origin
    getOrigin NamedArg Pattern
    p)
                (NamedArg DeBruijnPattern -> NamedArg DeBruijnPattern)
    -> TCMT IO (NamedArg DeBruijnPattern)
    -> TCMT IO (NamedArg DeBruijnPattern)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ((Named NamedName DeBruijnPattern
     -> TCMT IO (Named NamedName DeBruijnPattern))
    -> NamedArg DeBruijnPattern -> TCMT IO (NamedArg DeBruijnPattern)
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    traverse ((Named NamedName DeBruijnPattern
      -> TCMT IO (Named NamedName DeBruijnPattern))
     -> NamedArg DeBruijnPattern -> TCMT IO (NamedArg DeBruijnPattern))
    -> (Named NamedName DeBruijnPattern
        -> TCMT IO (Named NamedName DeBruijnPattern))
    -> NamedArg DeBruijnPattern
    -> TCMT IO (NamedArg DeBruijnPattern)
    forall a b. (a -> b) -> a -> b
    $ (DeBruijnPattern -> TCMT IO DeBruijnPattern)
    -> Named NamedName DeBruijnPattern
    -> TCMT IO (Named NamedName DeBruijnPattern)
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    traverse ((DeBruijnPattern -> TCMT IO DeBruijnPattern)
     -> Named NamedName DeBruijnPattern
     -> TCMT IO (Named NamedName DeBruijnPattern))
    -> (DeBruijnPattern -> TCMT IO DeBruijnPattern)
    -> Named NamedName DeBruijnPattern
    -> TCMT IO (Named NamedName DeBruijnPattern)
    forall a b. (a -> b) -> a -> b
    $ Pattern -> DeBruijnPattern -> TCMT IO DeBruijnPattern
    transfer (Pattern -> DeBruijnPattern -> TCMT IO DeBruijnPattern)
    -> Pattern -> DeBruijnPattern -> TCMT IO DeBruijnPattern
    forall a b. (a -> b) -> a -> b
    $ NamedArg Pattern -> Pattern
    forall a. NamedArg a -> a
    namedArg NamedArg Pattern
    p) NamedArg DeBruijnPattern
    q
              (NamedArg DeBruijnPattern
    q' NamedArg DeBruijnPattern
    -> [NamedArg DeBruijnPattern] -> [NamedArg DeBruijnPattern]
    forall a. a -> [a] -> [a]
    :) ([NamedArg DeBruijnPattern] -> [NamedArg DeBruijnPattern])
    -> TCM [NamedArg DeBruijnPattern] -> TCM [NamedArg DeBruijnPattern]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [NamedArg Pattern]
    -> [NamedArg DeBruijnPattern] -> TCM [NamedArg DeBruijnPattern]
    transfers [NamedArg Pattern]
    ps [NamedArg DeBruijnPattern]
    qs
          | Bool
    otherwise = (Origin -> NamedArg DeBruijnPattern -> NamedArg DeBruijnPattern
    forall a. LensOrigin a => Origin -> a -> a
    setOrigin Origin
    Inserted NamedArg DeBruijnPattern
    q NamedArg DeBruijnPattern
    -> [NamedArg DeBruijnPattern] -> [NamedArg DeBruijnPattern]
    forall a. a -> [a] -> [a]
    :) ([NamedArg DeBruijnPattern] -> [NamedArg DeBruijnPattern])
    -> TCM [NamedArg DeBruijnPattern] -> TCM [NamedArg DeBruijnPattern]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [NamedArg Pattern]
    -> [NamedArg DeBruijnPattern] -> TCM [NamedArg DeBruijnPattern]
    transfers (NamedArg Pattern
    p NamedArg Pattern -> [NamedArg Pattern] -> [NamedArg Pattern]
    forall a. a -> [a] -> [a]
    : [NamedArg Pattern]
    ps) [NamedArg DeBruijnPattern]
    qs

        transfer :: A.Pattern -> DeBruijnPattern -> TCM DeBruijnPattern
        transfer :: Pattern -> DeBruijnPattern -> TCMT IO DeBruijnPattern
    transfer Pattern
    p DeBruijnPattern
    q = case (Pattern -> ([Name], [Expr], Pattern)
    asView Pattern
    p , DeBruijnPattern
    q) of

          (([Name]
    asB , [Expr]
    anns , A.ConP ConPatInfo
    pi AmbiguousQName
    _ [NamedArg Pattern]
    ps) , ConP ConHead
    c (ConPatternInfo PatternInfo
    i Bool
    r Bool
    ft Maybe (Arg Type)
    mb Bool
    l) [NamedArg DeBruijnPattern]
    qs) -> do
            let cpi :: ConPatternInfo
    cpi = PatternInfo
    -> Bool -> Bool -> Maybe (Arg Type) -> Bool -> ConPatternInfo
    ConPatternInfo (PatOrigin -> [Name] -> PatternInfo
    PatternInfo PatOrigin
    PatOCon [Name]
    asB) Bool
    r Bool
    ft Maybe (Arg Type)
    mb Bool
    l
            ConHead
    -> ConPatternInfo -> [NamedArg DeBruijnPattern] -> DeBruijnPattern
    forall x.
    ConHead -> ConPatternInfo -> [NamedArg (Pattern' x)] -> Pattern' x
    ConP ConHead
    c ConPatternInfo
    cpi ([NamedArg DeBruijnPattern] -> DeBruijnPattern)
    -> TCM [NamedArg DeBruijnPattern] -> TCMT IO DeBruijnPattern
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [NamedArg Pattern]
    -> [NamedArg DeBruijnPattern] -> TCM [NamedArg DeBruijnPattern]
    transfers [NamedArg Pattern]
    ps [NamedArg DeBruijnPattern]
    qs

          (([Name]
    asB , [Expr]
    anns , A.RecP PatInfo
    pi [FieldAssignment' Pattern]
    fs) , ConP ConHead
    c (ConPatternInfo PatternInfo
    i Bool
    r Bool
    ft Maybe (Arg Type)
    mb Bool
    l) [NamedArg DeBruijnPattern]
    qs) -> do
            let Def QName
    d Elims
    _  = Type -> Term
    forall t a. Type'' t a -> a
    unEl (Type -> Term) -> Type -> Term
    forall a b. (a -> b) -> a -> b
    $ Arg Type -> Type
    forall e. Arg e -> e
    unArg (Arg Type -> Type) -> Arg Type -> Type
    forall a b. (a -> b) -> a -> b
    $ Arg Type -> Maybe (Arg Type) -> Arg Type
    forall a. a -> Maybe a -> a
    fromMaybe Arg Type
    forall a. HasCallStack => a
    __IMPOSSIBLE__ Maybe (Arg Type)
    mb
                axs :: [Arg Name]
    axs = (Arg QName -> Name) -> [Arg QName] -> [Name]
    forall a b. (a -> b) -> [a] -> [b]
    map (Name -> Name
    nameConcrete (Name -> Name) -> (Arg QName -> Name) -> Arg QName -> Name
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . QName -> Name
    qnameName (QName -> Name) -> (Arg QName -> QName) -> Arg QName -> Name
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Arg QName -> QName
    forall e. Arg e -> e
    unArg) (ConHead -> [Arg QName]
    conFields ConHead
    c) [Name] -> [NamedArg DeBruijnPattern] -> [Arg Name]
    forall a b. [a] -> [Arg b] -> [Arg a]
    `withArgsFrom` [NamedArg DeBruijnPattern]
    qs
                cpi :: ConPatternInfo
    cpi = PatternInfo
    -> Bool -> Bool -> Maybe (Arg Type) -> Bool -> ConPatternInfo
    ConPatternInfo (PatOrigin -> [Name] -> PatternInfo
    PatternInfo PatOrigin
    PatORec [Name]
    asB) Bool
    r Bool
    ft Maybe (Arg Type)
    mb Bool
    l
            [NamedArg Pattern]
    ps <- QName
    -> (Name -> Pattern)
    -> [FieldAssignment' Pattern]
    -> [Arg Name]
    -> TCMT IO [NamedArg Pattern]
    forall a.
    HasRange a =>
    QName
    -> (Name -> a)
    -> [FieldAssignment' a]
    -> [Arg Name]
    -> TCM [NamedArg a]
    insertMissingFieldsFail QName
    d (Pattern -> Name -> Pattern
    forall a b. a -> b -> a
    const (Pattern -> Name -> Pattern) -> Pattern -> Name -> Pattern
    forall a b. (a -> b) -> a -> b
    $ PatInfo -> Pattern
    forall e. PatInfo -> Pattern' e
    A.WildP PatInfo
    patNoRange) [FieldAssignment' Pattern]
    fs [Arg Name]
    axs
            ConHead
    -> ConPatternInfo -> [NamedArg DeBruijnPattern] -> DeBruijnPattern
    forall x.
    ConHead -> ConPatternInfo -> [NamedArg (Pattern' x)] -> Pattern' x
    ConP ConHead
    c ConPatternInfo
    cpi ([NamedArg DeBruijnPattern] -> DeBruijnPattern)
    -> TCM [NamedArg DeBruijnPattern] -> TCMT IO DeBruijnPattern
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [NamedArg Pattern]
    -> [NamedArg DeBruijnPattern] -> TCM [NamedArg DeBruijnPattern]
    transfers [NamedArg Pattern]
    ps [NamedArg DeBruijnPattern]
    qs

          (([Name]
    asB , [Expr]
    anns , Pattern
    p) , ConP ConHead
    c (ConPatternInfo PatternInfo
    i Bool
    r Bool
    ft Maybe (Arg Type)
    mb Bool
    l) [NamedArg DeBruijnPattern]
    qs) -> do
            let cpi :: ConPatternInfo
    cpi = PatternInfo
    -> Bool -> Bool -> Maybe (Arg Type) -> Bool -> ConPatternInfo
    ConPatternInfo (PatOrigin -> [Name] -> PatternInfo
    PatternInfo (Pattern -> PatOrigin
    patOrig Pattern
    p) [Name]
    asB) Bool
    r Bool
    ft Maybe (Arg Type)
    mb Bool
    l
            DeBruijnPattern -> TCMT IO DeBruijnPattern
    forall (m :: * -> *) a. Monad m => a -> m a
    return (DeBruijnPattern -> TCMT IO DeBruijnPattern)
    -> DeBruijnPattern -> TCMT IO DeBruijnPattern
    forall a b. (a -> b) -> a -> b
    $ ConHead
    -> ConPatternInfo -> [NamedArg DeBruijnPattern] -> DeBruijnPattern
    forall x.
    ConHead -> ConPatternInfo -> [NamedArg (Pattern' x)] -> Pattern' x
    ConP ConHead
    c ConPatternInfo
    cpi [NamedArg DeBruijnPattern]
    qs

          (([Name]
    asB , [Expr]
    anns , Pattern
    p) , VarP PatternInfo
    _ DBPatVar
    x) -> DeBruijnPattern -> TCMT IO DeBruijnPattern
    forall (m :: * -> *) a. Monad m => a -> m a
    return (DeBruijnPattern -> TCMT IO DeBruijnPattern)
    -> DeBruijnPattern -> TCMT IO DeBruijnPattern
    forall a b. (a -> b) -> a -> b
    $ PatternInfo -> DBPatVar -> DeBruijnPattern
    forall x. PatternInfo -> x -> Pattern' x
    VarP (PatOrigin -> [Name] -> PatternInfo
    PatternInfo (Pattern -> PatOrigin
    patOrig Pattern
    p) [Name]
    asB) DBPatVar
    x

          (([Name]
    asB , [Expr]
    anns , Pattern
    p) , DotP PatternInfo
    _ Term
    u) -> DeBruijnPattern -> TCMT IO DeBruijnPattern
    forall (m :: * -> *) a. Monad m => a -> m a
    return (DeBruijnPattern -> TCMT IO DeBruijnPattern)
    -> DeBruijnPattern -> TCMT IO DeBruijnPattern
    forall a b. (a -> b) -> a -> b
    $ PatternInfo -> Term -> DeBruijnPattern
    forall x. PatternInfo -> Term -> Pattern' x
    DotP (PatOrigin -> [Name] -> PatternInfo
    PatternInfo (Pattern -> PatOrigin
    patOrig Pattern
    p) [Name]
    asB) Term
    u

          (([Name]
    asB , [Expr]
    anns , Pattern
    p) , LitP PatternInfo
    _ Literal
    l) -> DeBruijnPattern -> TCMT IO DeBruijnPattern
    forall (m :: * -> *) a. Monad m => a -> m a
    return (DeBruijnPattern -> TCMT IO DeBruijnPattern)
    -> DeBruijnPattern -> TCMT IO DeBruijnPattern
    forall a b. (a -> b) -> a -> b
    $ PatternInfo -> Literal -> DeBruijnPattern
    forall x. PatternInfo -> Literal -> Pattern' x
    LitP (PatOrigin -> [Name] -> PatternInfo
    PatternInfo (Pattern -> PatOrigin
    patOrig Pattern
    p) [Name]
    asB) Literal
    l

          (([Name], [Expr], Pattern), DeBruijnPattern)
    _ -> DeBruijnPattern -> TCMT IO DeBruijnPattern
    forall (m :: * -> *) a. Monad m => a -> m a
    return DeBruijnPattern
    q

        patOrig :: A.Pattern -> PatOrigin
        patOrig :: Pattern -> PatOrigin
    patOrig (A.VarP BindName
    x)      = Name -> PatOrigin
    PatOVar (BindName -> Name
    A.unBind BindName
    x)
        patOrig A.DotP{}        = PatOrigin
    PatODot
        patOrig A.ConP{}        = PatOrigin
    PatOCon
        patOrig A.RecP{}        = PatOrigin
    PatORec
        patOrig A.WildP{}       = PatOrigin
    PatOWild
        patOrig A.AbsurdP{}     = PatOrigin
    PatOAbsurd
        patOrig A.LitP{}        = PatOrigin
    PatOLit
        patOrig A.EqualP{}      = PatOrigin
    PatOCon --TODO: origin for EqualP
        patOrig A.AsP{}         = PatOrigin
    forall a. HasCallStack => a
    __IMPOSSIBLE__
        patOrig A.ProjP{}       = PatOrigin
    forall a. HasCallStack => a
    __IMPOSSIBLE__
        patOrig A.DefP{}        = PatOrigin
    forall a. HasCallStack => a
    __IMPOSSIBLE__
        patOrig A.PatternSynP{} = PatOrigin
    forall a. HasCallStack => a
    __IMPOSSIBLE__
        patOrig A.WithP{}       = PatOrigin
    forall a. HasCallStack => a
    __IMPOSSIBLE__
        patOrig A.AnnP{}        = PatOrigin
    forall a. HasCallStack => a
    __IMPOSSIBLE__

        matchingArgs :: NamedArg A.Pattern -> NamedArg DeBruijnPattern -> Bool
        matchingArgs :: NamedArg Pattern -> NamedArg DeBruijnPattern -> Bool
    matchingArgs NamedArg Pattern
    p NamedArg DeBruijnPattern
    q
          -- The arguments match if
          -- 1. they are both projections,
          | Maybe (ProjOrigin, AmbiguousQName) -> Bool
    forall a. Maybe a -> Bool
    isJust (NamedArg Pattern -> Maybe (ProjOrigin, AmbiguousQName)
    forall a. IsProjP a => a -> Maybe (ProjOrigin, AmbiguousQName)
    A.isProjP NamedArg Pattern
    p) = Maybe (ProjOrigin, AmbiguousQName) -> Bool
    forall a. Maybe a -> Bool
    isJust (NamedArg DeBruijnPattern -> Maybe (ProjOrigin, AmbiguousQName)
    forall a. IsProjP a => a -> Maybe (ProjOrigin, AmbiguousQName)
    isProjP NamedArg DeBruijnPattern
    q)
          -- 2. or they are both visible,
          | NamedArg Pattern -> Bool
    forall a. LensHiding a => a -> Bool
    visible NamedArg Pattern
    p Bool -> Bool -> Bool
    && NamedArg DeBruijnPattern -> Bool
    forall a. LensHiding a => a -> Bool
    visible NamedArg DeBruijnPattern
    q = Bool
    True
          -- 3. or they have the same hiding and the argument is not named,
          | NamedArg Pattern -> NamedArg DeBruijnPattern -> Bool
    forall a b. (LensHiding a, LensHiding b) => a -> b -> Bool
    sameHiding NamedArg Pattern
    p NamedArg DeBruijnPattern
    q Bool -> Bool -> Bool
    && Maybe NamedName -> Bool
    forall a. Maybe a -> Bool
    isNothing (NamedArg Pattern -> Maybe (NameOf (NamedArg Pattern))
    forall a. LensNamed a => a -> Maybe (NameOf a)
    getNameOf NamedArg Pattern
    p) = Bool
    True
          -- 4. or they have the same hiding and the same name.
          | NamedArg Pattern -> NamedArg DeBruijnPattern -> Bool
    forall a b. (LensHiding a, LensHiding b) => a -> b -> Bool
    sameHiding NamedArg Pattern
    p NamedArg DeBruijnPattern
    q Bool -> Bool -> Bool
    && NamedArg Pattern -> NamedArg DeBruijnPattern -> Bool
    forall a b.
    (LensNamed a, LensNamed b, NameOf a ~ NamedName,
     NameOf b ~ NamedName) =>
    a -> b -> Bool
    namedSame NamedArg Pattern
    p NamedArg DeBruijnPattern
    q = Bool
    True
          -- Otherwise this argument was inserted by the typechecker.
          | Bool
    otherwise = Bool
    False

    -- | If a user-written variable occurs more than once, it should be bound
    --   to the same internal variable (or term) in all positions.
    --   Returns the list of patterns with the duplicate user patterns removed.
    checkPatternLinearity :: [ProblemEq] -> TCM [ProblemEq]
    checkPatternLinearity :: [ProblemEq] -> TCMT IO [ProblemEq]
    checkPatternLinearity [ProblemEq]
    eqs = do
      [Char] -> Int -> TCMT IO Doc -> TCMT IO ()
    forall (m :: * -> *).
    MonadDebug m =>
    [Char] -> Int -> TCMT IO Doc -> m ()
    reportSDoc [Char]
    "tc.lhs.linear" Int
    30 (TCMT IO Doc -> TCMT IO ()) -> TCMT IO Doc -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ TCMT IO Doc
    "Checking linearity of pattern variables"
      Map BindName (Term, Type) -> [ProblemEq] -> TCMT IO [ProblemEq]
    check Map BindName (Term, Type)
    forall k a. Map k a
    Map.empty [ProblemEq]
    eqs
      where
        check :: Map A.BindName (Term, Type) -> [ProblemEq] -> TCM [ProblemEq]
        check :: Map BindName (Term, Type) -> [ProblemEq] -> TCMT IO [ProblemEq]
    check Map BindName (Term, Type)
    _ [] = [ProblemEq] -> TCMT IO [ProblemEq]
    forall (m :: * -> *) a. Monad m => a -> m a
    return []
        check Map BindName (Term, Type)
    vars (eq :: ProblemEq
    eq@(ProblemEq Pattern
    p Term
    u Dom' Term Type
    a) : [ProblemEq]
    eqs) = do
          [Char] -> Int -> TCMT IO Doc -> TCMT IO ()
    forall (m :: * -> *).
    MonadDebug m =>
    [Char] -> Int -> TCMT IO Doc -> m ()
    reportSDoc [Char]
    "tc.lhs.linear" Int
    40 (TCMT IO Doc -> TCMT IO ()) -> TCMT IO Doc -> TCMT IO ()
    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
    "linearity: checking pattern "
            , Pattern -> TCMT IO Doc
    forall a (m :: * -> *).
    (ToConcrete a, Pretty (ConOfAbs a), MonadAbsToCon m) =>
    a -> m Doc
    prettyA Pattern
    p
            , TCMT IO Doc
    " equal to term "
            , Term -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM Term
    u
            , TCMT IO Doc
    " of type "
            , Dom' Term Type -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM Dom' Term Type
    a
            ]
          case Pattern
    p of
            A.VarP BindName
    x -> do
              let y :: Name
    y = BindName -> Name
    A.unBind BindName
    x
              [Char] -> Int -> [Char] -> TCMT IO ()
    forall (m :: * -> *).
    MonadDebug m =>
    [Char] -> Int -> [Char] -> m ()
    reportSLn [Char]
    "tc.lhs.linear" Int
    60 ([Char] -> TCMT IO ()) -> [Char] -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $
                [Char]
    "pattern variable " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Name -> [Char]
    forall a. Pretty a => a -> [Char]
    prettyShow (Name -> Name
    A.nameConcrete Name
    y) [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    " with id " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ NameId -> [Char]
    forall a. Show a => a -> [Char]
    show (Name -> NameId
    A.nameId Name
    y)
              case BindName -> Map BindName (Term, Type) -> Maybe (Term, Type)
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup BindName
    x Map BindName (Term, Type)
    vars of
                Just (Term
    v , Type
    b) -> do
                  Call -> TCMT IO () -> TCMT IO ()
    forall (m :: * -> *) a. MonadTrace m => Call -> m a -> m a
    traceCall (Name -> Call
    CheckPatternLinearityType (Name -> Call) -> Name -> Call
    forall a b. (a -> b) -> a -> b
    $ Name -> Name
    A.nameConcrete Name
    y) (TCMT IO () -> TCMT IO ()) -> TCMT IO () -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $
                    TCMT IO () -> TCMT IO ()
    forall (m :: * -> *) a.
    (MonadConstraint m, MonadWarning m, MonadError TCErr m,
     MonadFresh ProblemId m) =>
    m a -> m a
    noConstraints (TCMT IO () -> TCMT IO ()) -> TCMT IO () -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ Type -> Type -> TCMT IO ()
    forall (m :: * -> *). MonadConversion m => Type -> Type -> m ()
    equalType (Dom' Term Type -> Type
    forall t e. Dom' t e -> e
    unDom Dom' Term Type
    a) Type
    b
                  Call -> TCMT IO () -> TCMT IO ()
    forall (m :: * -> *) a. MonadTrace m => Call -> m a -> m a
    traceCall (Name -> Call
    CheckPatternLinearityValue (Name -> Call) -> Name -> Call
    forall a b. (a -> b) -> a -> b
    $ Name -> Name
    A.nameConcrete Name
    y) (TCMT IO () -> TCMT IO ()) -> TCMT IO () -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $
                    TCMT IO () -> TCMT IO ()
    forall (m :: * -> *) a.
    (MonadConstraint m, MonadWarning m, MonadError TCErr m,
     MonadFresh ProblemId m) =>
    m a -> m a
    noConstraints (TCMT IO () -> TCMT IO ()) -> TCMT IO () -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ Type -> Term -> Term -> TCMT IO ()
    forall (m :: * -> *).
    MonadConversion m =>
    Type -> Term -> Term -> m ()
    equalTerm (Dom' Term Type -> Type
    forall t e. Dom' t e -> e
    unDom Dom' Term Type
    a) Term
    u Term
    v
                  Map BindName (Term, Type) -> [ProblemEq] -> TCMT IO [ProblemEq]
    check Map BindName (Term, Type)
    vars [ProblemEq]
    eqs
                Maybe (Term, Type)
    Nothing -> (ProblemEq
    eqProblemEq -> [ProblemEq] -> [ProblemEq]
    forall a. a -> [a] -> [a]
    :) ([ProblemEq] -> [ProblemEq])
    -> TCMT IO [ProblemEq] -> TCMT IO [ProblemEq]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> do
                  Map BindName (Term, Type) -> [ProblemEq] -> TCMT IO [ProblemEq]
    check (BindName
    -> (Term, Type)
    -> Map BindName (Term, Type)
    -> Map BindName (Term, Type)
    forall k a. Ord k => k -> a -> Map k a -> Map k a
    Map.insert BindName
    x (Term
    u,Dom' Term Type -> Type
    forall t e. Dom' t e -> e
    unDom Dom' Term Type
    a) Map BindName (Term, Type)
    vars) [ProblemEq]
    eqs
            A.AsP PatInfo
    _ BindName
    x Pattern
    p ->
              Map BindName (Term, Type) -> [ProblemEq] -> TCMT IO [ProblemEq]
    check Map BindName (Term, Type)
    vars ([ProblemEq] -> TCMT IO [ProblemEq])
    -> [ProblemEq] -> TCMT IO [ProblemEq]
    forall a b. (a -> b) -> a -> b
    $ [Pattern -> Term -> Dom' Term Type -> ProblemEq
    ProblemEq (BindName -> Pattern
    forall e. BindName -> Pattern' e
    A.VarP BindName
    x) Term
    u Dom' Term Type
    a, Pattern -> Term -> Dom' Term Type -> ProblemEq
    ProblemEq Pattern
    p Term
    u Dom' Term Type
    a] [ProblemEq] -> [ProblemEq] -> [ProblemEq]
    forall a. [a] -> [a] -> [a]
    ++ [ProblemEq]
    eqs
            A.AnnP PatInfo
    _ Expr
    _ A.WildP{} -> TCMT IO [ProblemEq]
    continue
            A.AnnP PatInfo
    r Expr
    t Pattern
    p -> (Pattern -> Term -> Dom' Term Type -> ProblemEq
    ProblemEq (PatInfo -> Expr -> Pattern -> Pattern
    forall e. PatInfo -> e -> Pattern' e -> Pattern' e
    A.AnnP PatInfo
    r Expr
    t (PatInfo -> Pattern
    forall e. PatInfo -> Pattern' e
    A.WildP PatInfo
    patNoRange)) Term
    u Dom' Term Type
    aProblemEq -> [ProblemEq] -> [ProblemEq]
    forall a. a -> [a] -> [a]
    :) ([ProblemEq] -> [ProblemEq])
    -> TCMT IO [ProblemEq] -> TCMT IO [ProblemEq]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$>
              Map BindName (Term, Type) -> [ProblemEq] -> TCMT IO [ProblemEq]
    check Map BindName (Term, Type)
    vars (Pattern -> Term -> Dom' Term Type -> ProblemEq
    ProblemEq Pattern
    p Term
    u Dom' Term Type
    a ProblemEq -> [ProblemEq] -> [ProblemEq]
    forall a. a -> [a] -> [a]
    : [ProblemEq]
    eqs)
            A.WildP{}       -> TCMT IO [ProblemEq]
    continue
            A.DotP{}        -> TCMT IO [ProblemEq]
    continue
            A.AbsurdP{}     -> TCMT IO [ProblemEq]
    continue
            A.ConP{}        -> TCMT IO [ProblemEq]
    forall a. HasCallStack => a
    __IMPOSSIBLE__
            A.ProjP{}       -> TCMT IO [ProblemEq]
    forall a. HasCallStack => a
    __IMPOSSIBLE__
            A.DefP{}        -> TCMT IO [ProblemEq]
    forall a. HasCallStack => a
    __IMPOSSIBLE__
            A.LitP{}        -> TCMT IO [ProblemEq]
    forall a. HasCallStack => a
    __IMPOSSIBLE__
            A.PatternSynP{} -> TCMT IO [ProblemEq]
    forall a. HasCallStack => a
    __IMPOSSIBLE__
            A.RecP{}        -> TCMT IO [ProblemEq]
    forall a. HasCallStack => a
    __IMPOSSIBLE__
            A.EqualP{}      -> TCMT IO [ProblemEq]
    forall a. HasCallStack => a
    __IMPOSSIBLE__
            A.WithP{}       -> TCMT IO [ProblemEq]
    forall a. HasCallStack => a
    __IMPOSSIBLE__

          where continue :: TCMT IO [ProblemEq]
    continue = (ProblemEq
    eqProblemEq -> [ProblemEq] -> [ProblemEq]
    forall a. a -> [a] -> [a]
    :) ([ProblemEq] -> [ProblemEq])
    -> TCMT IO [ProblemEq] -> TCMT IO [ProblemEq]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Map BindName (Term, Type) -> [ProblemEq] -> TCMT IO [ProblemEq]
    check Map BindName (Term, Type)
    vars [ProblemEq]
    eqs

    -- | Construct the context for a left hand side, making up out-of-scope names
    --   for unnamed variables.
    computeLHSContext :: [Maybe A.Name] -> Telescope -> TCM Context
    computeLHSContext :: [Maybe Name] -> Tele (Dom' Term Type) -> TCM Context
    computeLHSContext = Context
    -> [Name] -> [Maybe Name] -> Tele (Dom' Term Type) -> TCM Context
    forall {m :: * -> *} {f :: * -> *} {a}.
    (MonadDebug m, PrettyTCM (Tele (f a)), MonadFresh NameId m,
     Subst (f a), Functor f) =>
    [f (Name, a)]
    -> [Name] -> [Maybe Name] -> Tele (f a) -> m [f (Name, a)]
    go [] []
      where
        go :: [f (Name, a)]
    -> [Name] -> [Maybe Name] -> Tele (f a) -> m [f (Name, a)]
    go [f (Name, a)]
    cxt [Name]
    _ []        tel :: Tele (f a)
    tel@ExtendTel{} = do
          [Char] -> Int -> TCMT IO Doc -> m ()
    forall (m :: * -> *).
    MonadDebug m =>
    [Char] -> Int -> TCMT IO Doc -> m ()
    reportSDoc [Char]
    "impossible" Int
    10 (TCMT IO Doc -> m ()) -> TCMT IO Doc -> m ()
    forall a b. (a -> b) -> a -> b
    $
            TCMT IO Doc
    "computeLHSContext: no patterns left, but tel =" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> Tele (f a) -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM Tele (f a)
    tel
          m [f (Name, a)]
    forall a. HasCallStack => a
    __IMPOSSIBLE__
        go [f (Name, a)]
    cxt [Name]
    _ (Maybe Name
    _ : [Maybe Name]
    _)   Tele (f a)
    EmptyTel = m [f (Name, a)]
    forall a. HasCallStack => a
    __IMPOSSIBLE__
        go [f (Name, a)]
    cxt [Name]
    _ []        Tele (f a)
    EmptyTel = [f (Name, a)] -> m [f (Name, a)]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [f (Name, a)]
    cxt
        go [f (Name, a)]
    cxt [Name]
    taken (Maybe Name
    x : [Maybe Name]
    xs) tel0 :: Tele (f a)
    tel0@(ExtendTel f a
    a Abs (Tele (f a))
    tel) = do
            Name
    name <- m Name -> (Name -> m Name) -> Maybe Name -> m Name
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe ([Name] -> [Char] -> m Name
    forall {m :: * -> *} {p}.
    MonadFresh NameId m =>
    p -> [Char] -> m Name
    dummyName [Name]
    taken ([Char] -> m Name) -> [Char] -> m Name
    forall a b. (a -> b) -> a -> b
    $ Abs (Tele (f a)) -> [Char]
    forall a. Abs a -> [Char]
    absName Abs (Tele (f a))
    tel) Name -> m Name
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe Name
    x
            let e :: f (Name, a)
    e = (Name
    name,) (a -> (Name, a)) -> f a -> f (Name, a)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> f a
    a
            [f (Name, a)]
    -> [Name] -> [Maybe Name] -> Tele (f a) -> m [f (Name, a)]
    go (f (Name, a)
    e f (Name, a) -> [f (Name, a)] -> [f (Name, a)]
    forall a. a -> [a] -> [a]
    : [f (Name, a)]
    cxt) (Name
    name Name -> [Name] -> [Name]
    forall a. a -> [a] -> [a]
    : [Name]
    taken) [Maybe Name]
    xs (Abs (Tele (f a)) -> Tele (f a)
    forall a. Subst a => Abs a -> a
    absBody Abs (Tele (f a))
    tel)

        dummyName :: p -> [Char] -> m Name
    dummyName p
    taken [Char]
    s =
          if [Char] -> Bool
    forall a. Underscore a => a -> Bool
    isUnderscore [Char]
    s then m Name
    forall (m :: * -> *). MonadFresh NameId m => m Name
    freshNoName_
          else Name -> Name
    forall a. LensInScope a => a -> a
    setNotInScope (Name -> Name) -> m Name -> m Name
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [Char] -> m Name
    forall a (m :: * -> *).
    (FreshName a, MonadFresh NameId m) =>
    a -> m Name
    freshName_ ([Char] -> [Char]
    argNameToString [Char]
    s)

    -- | Bind as patterns
    bindAsPatterns :: [AsBinding] -> TCM a -> TCM a
    bindAsPatterns :: forall a. [AsBinding] -> TCM a -> TCM a
    bindAsPatterns []                TCM a
    ret = TCM a
    ret
    bindAsPatterns (AsB Name
    x Term
    v Type
    a Modality
    m : [AsBinding]
    asb) TCM a
    ret = do
      [Char] -> Int -> TCMT IO Doc -> TCMT IO ()
    forall (m :: * -> *).
    MonadDebug m =>
    [Char] -> Int -> TCMT IO Doc -> m ()
    reportSDoc [Char]
    "tc.lhs.as" Int
    10 (TCMT IO Doc -> TCMT IO ()) -> TCMT IO Doc -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ TCMT IO Doc
    "as pattern" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> Name -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM Name
    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 [ 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 a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM Type
    a
            , 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
            ]
      ArgInfo -> Name -> Term -> Type -> TCM a -> TCM a
    forall (m :: * -> *) a.
    MonadAddContext m =>
    ArgInfo -> Name -> Term -> Type -> m a -> m a
    addLetBinding (Modality -> ArgInfo -> ArgInfo
    forall a. LensModality a => Modality -> a -> a
    setModality Modality
    m ArgInfo
    defaultArgInfo) Name
    x Term
    v Type
    a (TCM a -> TCM a) -> TCM a -> TCM a
    forall a b. (a -> b) -> a -> b
    $ [AsBinding] -> TCM a -> TCM a
    forall a. [AsBinding] -> TCM a -> TCM a
    bindAsPatterns [AsBinding]
    asb TCM a
    ret

    -- | Since with-abstraction can change the type of a variable, we have to
    --   recheck the stripped with patterns when checking a with function.
    recheckStrippedWithPattern :: ProblemEq -> TCM ()
    recheckStrippedWithPattern :: ProblemEq -> TCMT IO ()
    recheckStrippedWithPattern (ProblemEq Pattern
    p Term
    v Dom' Term Type
    a) = Term -> Comparison -> Type -> TCMT IO ()
    forall (m :: * -> *).
    MonadCheckInternal m =>
    Term -> Comparison -> Type -> m ()
    checkInternal Term
    v Comparison
    CmpLeq (Dom' Term Type -> Type
    forall t e. Dom' t e -> e
    unDom Dom' Term Type
    a)
      TCMT IO () -> (TCErr -> TCMT IO ()) -> TCMT IO ()
    forall e (m :: * -> *) a.
    MonadError e m =>
    m a -> (e -> m a) -> m a
    `catchError` \TCErr
    _ -> TypeError -> TCMT IO ()
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCError m) =>
    TypeError -> m a
    typeError (TypeError -> TCMT IO ())
    -> (Doc -> TypeError) -> Doc -> TCMT IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Doc -> TypeError
    GenericDocError (Doc -> TCMT IO ()) -> TCMT IO Doc -> TCMT IO ()
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< [TCMT IO Doc] -> TCMT IO Doc
    forall (m :: * -> *) (t :: * -> *).
    (Applicative m, Foldable t) =>
    t (m Doc) -> m Doc
    vcat
        [ TCMT IO Doc
    "Ill-typed pattern after with abstraction: " TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> Pattern -> TCMT IO Doc
    forall a (m :: * -> *).
    (ToConcrete a, Pretty (ConOfAbs a), MonadAbsToCon m) =>
    a -> m Doc
    prettyA Pattern
    p
        , TCMT IO Doc
    "(perhaps you can replace it by `_`?)"
        ]

    -- | Result of checking the LHS of a clause.
    data LHSResult = LHSResult
      { LHSResult -> Int
    lhsParameters   :: Nat
        -- ^ The number of original module parameters. These are present in the
        -- the patterns.
      , LHSResult -> Tele (Dom' Term Type)
    lhsVarTele      :: Telescope
        -- ^ Δ : The types of the pattern variables, in internal dependency order.
        -- Corresponds to 'clauseTel'.
      , LHSResult -> [NamedArg DeBruijnPattern]
    lhsPatterns     :: [NamedArg DeBruijnPattern]
        -- ^ The patterns in internal syntax.
      , LHSResult -> Bool
    lhsHasAbsurd    :: Bool
        -- ^ Whether the LHS has at least one absurd pattern.
      , LHSResult -> Arg Type
    lhsBodyType     :: Arg Type
        -- ^ The type of the body. Is @bσ@ if @Γ@ is defined.
        -- 'Irrelevant' to indicate the rhs must be checked in irrelevant mode.
      , LHSResult -> Substitution
    lhsPatSubst     :: Substitution
        -- ^ Substitution version of @lhsPatterns@, only up to the first projection
        -- pattern. @Δ |- lhsPatSubst : Γ@. Where @Γ@ is the argument telescope of
        -- the function. This is used to update inherited dot patterns in
        -- with-function clauses.
      , LHSResult -> [AsBinding]
    lhsAsBindings   :: [AsBinding]
        -- ^ As-bindings from the left-hand side. Return instead of bound since we
        -- want them in where's and right-hand sides, but not in with-clauses
        -- (Issue 2303).
      , LHSResult -> IntSet
    lhsPartialSplit :: IntSet
        -- ^ have we done a partial split?
      }

    instance InstantiateFull LHSResult where
      instantiateFull' :: LHSResult -> ReduceM LHSResult
    instantiateFull' (LHSResult Int
    n Tele (Dom' Term Type)
    tel [NamedArg DeBruijnPattern]
    ps Bool
    abs Arg Type
    t Substitution
    sub [AsBinding]
    as IntSet
    psplit) = Int
    -> Tele (Dom' Term Type)
    -> [NamedArg DeBruijnPattern]
    -> Bool
    -> Arg Type
    -> Substitution
    -> [AsBinding]
    -> IntSet
    -> LHSResult
    LHSResult Int
    n
        (Tele (Dom' Term Type)
     -> [NamedArg DeBruijnPattern]
     -> Bool
     -> Arg Type
     -> Substitution
     -> [AsBinding]
     -> IntSet
     -> LHSResult)
    -> ReduceM (Tele (Dom' Term Type))
    -> ReduceM
         ([NamedArg DeBruijnPattern]
          -> Bool
          -> Arg Type
          -> Substitution
          -> [AsBinding]
          -> IntSet
          -> LHSResult)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Tele (Dom' Term Type) -> ReduceM (Tele (Dom' Term Type))
    forall t. InstantiateFull t => t -> ReduceM t
    instantiateFull' Tele (Dom' Term Type)
    tel
        ReduceM
      ([NamedArg DeBruijnPattern]
       -> Bool
       -> Arg Type
       -> Substitution
       -> [AsBinding]
       -> IntSet
       -> LHSResult)
    -> ReduceM [NamedArg DeBruijnPattern]
    -> ReduceM
         (Bool
          -> Arg Type -> Substitution -> [AsBinding] -> IntSet -> LHSResult)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> [NamedArg DeBruijnPattern] -> ReduceM [NamedArg DeBruijnPattern]
    forall t. InstantiateFull t => t -> ReduceM t
    instantiateFull' [NamedArg DeBruijnPattern]
    ps
        ReduceM
      (Bool
       -> Arg Type -> Substitution -> [AsBinding] -> IntSet -> LHSResult)
    -> ReduceM Bool
    -> ReduceM
         (Arg Type -> Substitution -> [AsBinding] -> IntSet -> LHSResult)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Bool -> ReduceM Bool
    forall t. InstantiateFull t => t -> ReduceM t
    instantiateFull' Bool
    abs
        ReduceM
      (Arg Type -> Substitution -> [AsBinding] -> IntSet -> LHSResult)
    -> ReduceM (Arg Type)
    -> ReduceM (Substitution -> [AsBinding] -> IntSet -> LHSResult)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Arg Type -> ReduceM (Arg Type)
    forall t. InstantiateFull t => t -> ReduceM t
    instantiateFull' Arg Type
    t
        ReduceM (Substitution -> [AsBinding] -> IntSet -> LHSResult)
    -> ReduceM Substitution
    -> ReduceM ([AsBinding] -> IntSet -> LHSResult)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Substitution -> ReduceM Substitution
    forall t. InstantiateFull t => t -> ReduceM t
    instantiateFull' Substitution
    sub
        ReduceM ([AsBinding] -> IntSet -> LHSResult)
    -> ReduceM [AsBinding] -> ReduceM (IntSet -> LHSResult)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> [AsBinding] -> ReduceM [AsBinding]
    forall t. InstantiateFull t => t -> ReduceM t
    instantiateFull' [AsBinding]
    as
        ReduceM (IntSet -> LHSResult)
    -> ReduceM IntSet -> ReduceM LHSResult
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> IntSet -> ReduceM IntSet
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure IntSet
    psplit

    -- | Check a LHS. Main function.
    --
    --   @checkLeftHandSide a ps a ret@ checks that user patterns @ps@ eliminate
    --   the type @a@ of the defined function, and calls continuation @ret@
    --   if successful.

    checkLeftHandSide :: forall a.
         Call
         -- ^ Trace, e.g. 'CheckLHS' or 'CheckPattern'.
      -> Maybe QName
         -- ^ The name of the definition we are checking.
      -> [NamedArg A.Pattern]
         -- ^ The patterns.
      -> Type
         -- ^ The expected type @a = Γ → b@.
      -> Maybe Substitution
         -- ^ Module parameter substitution from with-abstraction.
      -> [ProblemEq]
         -- ^ Patterns that have been stripped away by with-desugaring.
         -- ^ These should not contain any proper matches.
      -> (LHSResult -> TCM a)
         -- ^ Continuation.
      -> TCM a
    checkLeftHandSide :: forall a.
    Call
    -> Maybe QName
    -> [NamedArg Pattern]
    -> Type
    -> Maybe Substitution
    -> [ProblemEq]
    -> (LHSResult -> TCM a)
    -> TCM a
    checkLeftHandSide Call
    call Maybe QName
    f [NamedArg Pattern]
    ps Type
    a Maybe Substitution
    withSub' [ProblemEq]
    strippedPats =
     Account (BenchPhase (TCMT IO))
    -> ((LHSResult -> TCMT IO a) -> TCMT IO a)
    -> (LHSResult -> TCMT IO a)
    -> TCMT IO a
    forall (m :: * -> *) b c.
    MonadBench m =>
    Account (BenchPhase m) -> ((b -> m c) -> m c) -> (b -> m c) -> m c
    Bench.billToCPS [BenchPhase (TCMT IO)
    Phase
    Bench.Typing, BenchPhase (TCMT IO)
    Phase
    Bench.CheckLHS] (((LHSResult -> TCMT IO a) -> TCMT IO a)
     -> (LHSResult -> TCMT IO a) -> TCMT IO a)
    -> ((LHSResult -> TCMT IO a) -> TCMT IO a)
    -> (LHSResult -> TCMT IO a)
    -> TCMT IO a
    forall a b. (a -> b) -> a -> b
    $
     Call
    -> ((LHSResult -> TCMT IO a) -> TCMT IO a)
    -> (LHSResult -> TCMT IO a)
    -> TCMT IO a
    forall (m :: * -> *) a b.
    MonadTrace m =>
    Call -> ((a -> m b) -> m b) -> (a -> m b) -> m b
    traceCallCPS Call
    call (((LHSResult -> TCMT IO a) -> TCMT IO a)
     -> (LHSResult -> TCMT IO a) -> TCMT IO a)
    -> ((LHSResult -> TCMT IO a) -> TCMT IO a)
    -> (LHSResult -> TCMT IO a)
    -> TCMT IO a
    forall a b. (a -> b) -> a -> b
    $ \ LHSResult -> TCMT IO a
    ret -> do

      -- To allow module parameters to be refined by matching, we're adding the
      -- context arguments as wildcard patterns and extending the type with the
      -- context telescope.
      Context
    cxt <- (Dom (Name, Type) -> Dom (Name, Type)) -> Context -> Context
    forall a b. (a -> b) -> [a] -> [b]
    map (Origin -> Dom (Name, Type) -> Dom (Name, Type)
    forall a. LensOrigin a => Origin -> a -> a
    setOrigin Origin
    Inserted) (Context -> Context) -> (Context -> Context) -> Context -> Context
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Context -> Context
    forall a. [a] -> [a]
    reverse (Context -> Context) -> TCM Context -> TCM Context
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> TCM Context
    forall (m :: * -> *). MonadTCEnv m => m Context
    getContext
      let tel :: Tele (Dom' Term Type)
    tel = (Name -> [Char]) -> Context -> Tele (Dom' Term Type)
    forall a. (a -> [Char]) -> ListTel' a -> Tele (Dom' Term Type)
    telFromList' Name -> [Char]
    forall a. Pretty a => a -> [Char]
    prettyShow Context
    cxt
          cps :: [NamedArg Pattern]
    cps = [ Pattern -> Named NamedName Pattern
    forall a name. a -> Named name a
    unnamed (Pattern -> Named NamedName Pattern)
    -> ((Name, Type) -> Pattern)
    -> (Name, Type)
    -> Named NamedName Pattern
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . BindName -> Pattern
    forall e. BindName -> Pattern' e
    A.VarP (BindName -> Pattern)
    -> ((Name, Type) -> BindName) -> (Name, Type) -> Pattern
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Name -> BindName
    A.mkBindName (Name -> BindName)
    -> ((Name, Type) -> Name) -> (Name, Type) -> BindName
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Name, Type) -> Name
    forall a b. (a, b) -> a
    fst ((Name, Type) -> Named NamedName Pattern)
    -> Arg (Name, Type) -> NamedArg Pattern
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Dom (Name, Type) -> Arg (Name, Type)
    forall t a. Dom' t a -> Arg a
    argFromDom Dom (Name, Type)
    d
                | Dom (Name, Type)
    d <- Context
    cxt ]
          eqs0 :: [ProblemEq]
    eqs0 = (Pattern -> Term -> Dom' Term Type -> ProblemEq)
    -> [Pattern] -> [Term] -> [Dom' Term Type] -> [ProblemEq]
    forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
    zipWith3 Pattern -> Term -> Dom' Term Type -> ProblemEq
    ProblemEq ((NamedArg Pattern -> Pattern) -> [NamedArg Pattern] -> [Pattern]
    forall a b. (a -> b) -> [a] -> [b]
    map NamedArg Pattern -> Pattern
    forall a. NamedArg a -> a
    namedArg [NamedArg Pattern]
    cps) ((Int -> Term) -> [Int] -> [Term]
    forall a b. (a -> b) -> [a] -> [b]
    map Int -> Term
    var ([Int] -> [Term]) -> [Int] -> [Term]
    forall a b. (a -> b) -> a -> b
    $ Int -> [Int]
    forall a. Integral a => a -> [a]
    downFrom (Int -> [Int]) -> Int -> [Int]
    forall a b. (a -> b) -> a -> b
    $ Tele (Dom' Term Type) -> Int
    forall a. Sized a => a -> Int
    size Tele (Dom' Term Type)
    tel) (Tele (Dom' Term Type) -> [Dom' Term Type]
    forall a. TermSubst a => Tele (Dom a) -> [Dom a]
    flattenTel Tele (Dom' Term Type)
    tel)

      let finalChecks :: LHSState a -> TCM a
          finalChecks :: LHSState a -> TCMT IO a
    finalChecks (LHSState Tele (Dom' Term Type)
    delta [NamedArg DeBruijnPattern]
    qs0 (Problem [ProblemEq]
    eqs [NamedArg Pattern]
    rps LHSState a -> TCMT IO a
    _) Arg Type
    b [Maybe Int]
    psplit) = do

            [Char] -> Int -> TCMT IO Doc -> TCMT IO ()
    forall (m :: * -> *).
    MonadDebug m =>
    [Char] -> Int -> TCMT IO Doc -> m ()
    reportSDoc [Char]
    "tc.lhs.top" Int
    20 (TCMT IO Doc -> TCMT IO ()) -> TCMT IO Doc -> TCMT IO ()
    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
    "lhs: final checks with remaining equations"
              , 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
    $ if [ProblemEq] -> Bool
    forall a. Null a => a -> Bool
    null [ProblemEq]
    eqs then TCMT IO Doc
    "(none)" else Tele (Dom' Term Type) -> TCMT IO Doc -> TCMT IO Doc
    forall b (m :: * -> *) a.
    (AddContext b, MonadAddContext m) =>
    b -> m a -> m a
    addContext Tele (Dom' Term Type)
    delta (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] -> TCMT IO Doc) -> [TCMT IO Doc] -> TCMT IO Doc
    forall a b. (a -> b) -> a -> b
    $ (ProblemEq -> TCMT IO Doc) -> [ProblemEq] -> [TCMT IO Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map ProblemEq -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM [ProblemEq]
    eqs
              , TCMT IO Doc
    "qs0 =" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> Tele (Dom' Term Type) -> TCMT IO Doc -> TCMT IO Doc
    forall b (m :: * -> *) a.
    (AddContext b, MonadAddContext m) =>
    b -> m a -> m a
    addContext Tele (Dom' Term Type)
    delta ([NamedArg DeBruijnPattern] -> TCMT IO Doc
    forall (m :: * -> *).
    MonadPretty m =>
    [NamedArg DeBruijnPattern] -> m Doc
    prettyTCMPatternList [NamedArg DeBruijnPattern]
    qs0)
              ]

            Bool -> TCMT IO () -> TCMT IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless ([NamedArg Pattern] -> Bool
    forall a. Null a => a -> Bool
    null [NamedArg Pattern]
    rps) TCMT IO ()
    forall a. HasCallStack => a
    __IMPOSSIBLE__

            Tele (Dom' Term Type) -> TCMT IO () -> TCMT IO ()
    forall b (m :: * -> *) a.
    (AddContext b, MonadAddContext m) =>
    b -> m a -> m a
    addContext Tele (Dom' Term Type)
    delta (TCMT IO () -> TCMT IO ()) -> TCMT IO () -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ do
              (ProblemEq -> TCMT IO ()) -> [ProblemEq] -> TCMT IO ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ ProblemEq -> TCMT IO ()
    noShadowingOfConstructors [ProblemEq]
    eqs

            Int
    arity_a <- Type -> TCM Int
    arityPiPath Type
    a
            -- Compute substitution from the out patterns @qs0@
            let notProj :: Pattern' x -> Bool
    notProj ProjP{} = Bool
    False
                notProj Pattern' x
    _       = Bool
    True
                numPats :: Int
    numPats  = [NamedArg DeBruijnPattern] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length ([NamedArg DeBruijnPattern] -> Int)
    -> [NamedArg DeBruijnPattern] -> Int
    forall a b. (a -> b) -> a -> b
    $ (NamedArg DeBruijnPattern -> Bool)
    -> [NamedArg DeBruijnPattern] -> [NamedArg DeBruijnPattern]
    forall a. (a -> Bool) -> [a] -> [a]
    takeWhile (DeBruijnPattern -> Bool
    forall {x}. Pattern' x -> Bool
    notProj (DeBruijnPattern -> Bool)
    -> (NamedArg DeBruijnPattern -> DeBruijnPattern)
    -> NamedArg DeBruijnPattern
    -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . NamedArg DeBruijnPattern -> DeBruijnPattern
    forall a. NamedArg a -> a
    namedArg) [NamedArg DeBruijnPattern]
    qs0

                -- We have two slightly different cases here: normal function and
                -- with-function. In both cases the goal is to build a substitution
                -- from the context Γ of the previous checkpoint to the current lhs
                -- context Δ:
                --
                --    Δ ⊢ paramSub : Γ
                --
                --  * Normal function, f
                --
                --    Γ = cxt = module parameter telescope of f
                --    Ψ = non-parameter arguments of f (we have f : Γ Ψ → A)
                --    Δ   ⊢ patSub  : Γ Ψ
                --    Γ Ψ ⊢ weakSub : Γ
                --    paramSub = patSub ∘ weakSub
                --
                --  * With-function
                --
                --    Γ = lhs context of the parent clause (cxt = [])
                --    Ψ = argument telescope of with-function
                --    Θ = inserted implicit patterns not in Ψ (#2827)
                --        (this happens if the goal computes to an implicit
                --         function type after some matching in the with-clause)
                --
                --    Ψ   ⊢ withSub : Γ
                --    Δ   ⊢ patSub  : Ψ Θ
                --    Ψ Θ ⊢ weakSub : Ψ
                --    paramSub = patSub ∘ weakSub ∘ withSub
                --
                --    To compute Θ we can look at the arity of the with-function
                --    and compare it to numPats. This works since the with-function
                --    type is fully reduced.

                weakSub :: Substitution
                weakSub :: Substitution
    weakSub | Maybe Substitution -> Bool
    forall a. Maybe a -> Bool
    isJust Maybe Substitution
    withSub' = Int -> Substitution -> Substitution
    forall a. Int -> Substitution' a -> Substitution' a
    wkS (Int -> Int -> Int
    forall a. Ord a => a -> a -> a
    max Int
    0 (Int -> Int) -> Int -> Int
    forall a b. (a -> b) -> a -> b
    $ Int
    numPats Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    arity_a) Substitution
    forall a. Substitution' a
    idS -- if numPats < arity, Θ is empty
                        | Bool
    otherwise       = Int -> Substitution -> Substitution
    forall a. Int -> Substitution' a -> Substitution' a
    wkS (Int
    numPats Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Context -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length Context
    cxt) Substitution
    forall a. Substitution' a
    idS
                withSub :: Substitution
    withSub  = Substitution -> Maybe Substitution -> Substitution
    forall a. a -> Maybe a -> a
    fromMaybe Substitution
    forall a. Substitution' a
    idS Maybe Substitution
    withSub'
                patSub :: Substitution
    patSub   = (NamedArg DeBruijnPattern -> Term)
    -> [NamedArg DeBruijnPattern] -> [Term]
    forall a b. (a -> b) -> [a] -> [b]
    map (DeBruijnPattern -> Term
    patternToTerm (DeBruijnPattern -> Term)
    -> (NamedArg DeBruijnPattern -> DeBruijnPattern)
    -> NamedArg DeBruijnPattern
    -> Term
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . NamedArg DeBruijnPattern -> DeBruijnPattern
    forall a. NamedArg a -> a
    namedArg) ([NamedArg DeBruijnPattern] -> [NamedArg DeBruijnPattern]
    forall a. [a] -> [a]
    reverse ([NamedArg DeBruijnPattern] -> [NamedArg DeBruijnPattern])
    -> [NamedArg DeBruijnPattern] -> [NamedArg DeBruijnPattern]
    forall a b. (a -> b) -> a -> b
    $ Int -> [NamedArg DeBruijnPattern] -> [NamedArg DeBruijnPattern]
    forall a. Int -> [a] -> [a]
    take Int
    numPats [NamedArg DeBruijnPattern]
    qs0) [Term] -> Substitution -> Substitution
    forall a. DeBruijn a => [a] -> Substitution' a -> Substitution' a
    ++# Impossible -> Substitution
    forall a. Impossible -> Substitution' a
    EmptyS Impossible
    HasCallStack => Impossible
    impossible
                paramSub :: Substitution
    paramSub = Substitution
    patSub Substitution -> Substitution -> Substitution
    forall a.
    EndoSubst a =>
    Substitution' a -> Substitution' a -> Substitution' a
    `composeS` Substitution
    weakSub Substitution -> Substitution -> Substitution
    forall a.
    EndoSubst a =>
    Substitution' a -> Substitution' a -> Substitution' a
    `composeS` Substitution
    withSub

            [ProblemEq]
    eqs <- Tele (Dom' Term Type) -> TCMT IO [ProblemEq] -> TCMT IO [ProblemEq]
    forall b (m :: * -> *) a.
    (AddContext b, MonadAddContext m) =>
    b -> m a -> m a
    addContext Tele (Dom' Term Type)
    delta (TCMT IO [ProblemEq] -> TCMT IO [ProblemEq])
    -> TCMT IO [ProblemEq] -> TCMT IO [ProblemEq]
    forall a b. (a -> b) -> a -> b
    $ [ProblemEq] -> TCMT IO [ProblemEq]
    checkPatternLinearity [ProblemEq]
    eqs

            leftovers :: LeftoverPatterns
    leftovers@(LeftoverPatterns IntMap [(Name, PatVarPosition)]
    patVars [AsBinding]
    asb0 [DotPattern]
    dots [AbsurdPattern]
    absurds [AnnotationPattern]
    annps [Pattern]
    otherPats)
              <- Tele (Dom' Term Type)
    -> TCMT IO LeftoverPatterns -> TCMT IO LeftoverPatterns
    forall b (m :: * -> *) a.
    (AddContext b, MonadAddContext m) =>
    b -> m a -> m a
    addContext Tele (Dom' Term Type)
    delta (TCMT IO LeftoverPatterns -> TCMT IO LeftoverPatterns)
    -> TCMT IO LeftoverPatterns -> TCMT IO LeftoverPatterns
    forall a b. (a -> b) -> a -> b
    $ [ProblemEq] -> TCMT IO LeftoverPatterns
    forall (m :: * -> *).
    PureTCM m =>
    [ProblemEq] -> m LeftoverPatterns
    getLeftoverPatterns [ProblemEq]
    eqs

            [Char] -> Int -> TCMT IO Doc -> TCMT IO ()
    forall (m :: * -> *).
    MonadDebug m =>
    [Char] -> Int -> TCMT IO Doc -> m ()
    reportSDoc [Char]
    "tc.lhs.leftover" Int
    30 (TCMT IO Doc -> TCMT IO ()) -> TCMT IO Doc -> TCMT IO ()
    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
    "leftover patterns: " , Int -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Functor m => Int -> m Doc -> m Doc
    nest Int
    2 (Tele (Dom' Term Type) -> TCMT IO Doc -> TCMT IO Doc
    forall b (m :: * -> *) a.
    (AddContext b, MonadAddContext m) =>
    b -> m a -> m a
    addContext Tele (Dom' Term Type)
    delta (TCMT IO Doc -> TCMT IO Doc) -> TCMT IO Doc -> TCMT IO Doc
    forall a b. (a -> b) -> a -> b
    $ LeftoverPatterns -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM LeftoverPatterns
    leftovers) ]

            Bool -> TCMT IO () -> TCMT IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless ([Pattern] -> Bool
    forall a. Null a => a -> Bool
    null [Pattern]
    otherPats) TCMT IO ()
    forall a. HasCallStack => a
    __IMPOSSIBLE__

            -- Get the user-written names for the pattern variables
            let ([Maybe Name]
    vars, [AsBinding]
    asb1) = Tele (Dom' Term Type)
    -> IntMap [(Name, PatVarPosition)] -> ([Maybe Name], [AsBinding])
    getUserVariableNames Tele (Dom' Term Type)
    delta IntMap [(Name, PatVarPosition)]
    patVars
                asb :: [AsBinding]
    asb          = [AsBinding]
    asb0 [AsBinding] -> [AsBinding] -> [AsBinding]
    forall a. [a] -> [a] -> [a]
    ++ [AsBinding]
    asb1

            -- Rename internal patterns with these names
            let makeVar :: Maybe Name -> Int -> DeBruijnPattern
    makeVar     = (Int -> DeBruijnPattern)
    -> (Name -> Int -> DeBruijnPattern)
    -> Maybe Name
    -> Int
    -> DeBruijnPattern
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Int -> DeBruijnPattern
    forall a. DeBruijn a => Int -> a
    deBruijnVar ((Name -> Int -> DeBruijnPattern)
     -> Maybe Name -> Int -> DeBruijnPattern)
    -> (Name -> Int -> DeBruijnPattern)
    -> Maybe Name
    -> Int
    -> DeBruijnPattern
    forall a b. (a -> b) -> a -> b
    $ [Char] -> Int -> DeBruijnPattern
    forall a. DeBruijn a => [Char] -> Int -> a
    debruijnNamedVar ([Char] -> Int -> DeBruijnPattern)
    -> (Name -> [Char]) -> Name -> Int -> DeBruijnPattern
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Name -> [Char]
    nameToArgName
                ren :: Substitution' DeBruijnPattern
    ren         = [DeBruijnPattern] -> Substitution' DeBruijnPattern
    forall a. DeBruijn a => [a] -> Substitution' a
    parallelS ([DeBruijnPattern] -> Substitution' DeBruijnPattern)
    -> [DeBruijnPattern] -> Substitution' DeBruijnPattern
    forall a b. (a -> b) -> a -> b
    $ (Maybe Name -> Int -> DeBruijnPattern)
    -> [Maybe Name] -> [Int] -> [DeBruijnPattern]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith Maybe Name -> Int -> DeBruijnPattern
    makeVar ([Maybe Name] -> [Maybe Name]
    forall a. [a] -> [a]
    reverse [Maybe Name]
    vars) [Int
    0..]

            [NamedArg DeBruijnPattern]
    qs <- [NamedArg Pattern]
    -> [NamedArg DeBruijnPattern] -> TCM [NamedArg DeBruijnPattern]
    transferOrigins ([NamedArg Pattern]
    cps [NamedArg Pattern] -> [NamedArg Pattern] -> [NamedArg Pattern]
    forall a. [a] -> [a] -> [a]
    ++ [NamedArg Pattern]
    ps) ([NamedArg DeBruijnPattern] -> TCM [NamedArg DeBruijnPattern])
    -> [NamedArg DeBruijnPattern] -> TCM [NamedArg DeBruijnPattern]
    forall a b. (a -> b) -> a -> b
    $ Substitution' (SubstArg [NamedArg DeBruijnPattern])
    -> [NamedArg DeBruijnPattern] -> [NamedArg DeBruijnPattern]
    forall a. Subst a => Substitution' (SubstArg a) -> a -> a
    applySubst Substitution' DeBruijnPattern
    Substitution' (SubstArg [NamedArg DeBruijnPattern])
    ren [NamedArg DeBruijnPattern]
    qs0

            let hasAbsurd :: Bool
    hasAbsurd = Bool -> Bool
    not (Bool -> Bool)
    -> ([AbsurdPattern] -> Bool) -> [AbsurdPattern] -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [AbsurdPattern] -> Bool
    forall a. Null a => a -> Bool
    null ([AbsurdPattern] -> Bool) -> [AbsurdPattern] -> Bool
    forall a b. (a -> b) -> a -> b
    $ [AbsurdPattern]
    absurds

            let lhsResult :: LHSResult
    lhsResult = Int
    -> Tele (Dom' Term Type)
    -> [NamedArg DeBruijnPattern]
    -> Bool
    -> Arg Type
    -> Substitution
    -> [AsBinding]
    -> IntSet
    -> LHSResult
    LHSResult (Context -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length Context
    cxt) Tele (Dom' Term Type)
    delta [NamedArg DeBruijnPattern]
    qs Bool
    hasAbsurd Arg Type
    b Substitution
    patSub [AsBinding]
    asb ([Int] -> IntSet
    IntSet.fromList ([Int] -> IntSet) -> [Int] -> IntSet
    forall a b. (a -> b) -> a -> b
    $ [Maybe Int] -> [Int]
    forall a. [Maybe a] -> [a]
    catMaybes [Maybe Int]
    psplit)

            -- Debug output
            [Char] -> Int -> TCMT IO Doc -> TCMT IO ()
    forall (m :: * -> *).
    MonadDebug m =>
    [Char] -> Int -> TCMT IO Doc -> m ()
    reportSDoc [Char]
    "tc.lhs.top" Int
    10 (TCMT IO Doc -> TCMT IO ()) -> TCMT IO Doc -> TCMT IO ()
    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
    "checked lhs:"
                   , 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
    "delta   = " TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> Tele (Dom' Term Type) -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM Tele (Dom' Term Type)
    delta
                     , TCMT IO Doc
    "dots    = " TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> Tele (Dom' Term Type) -> TCMT IO Doc -> TCMT IO Doc
    forall b (m :: * -> *) a.
    (AddContext b, MonadAddContext m) =>
    b -> m a -> m a
    addContext Tele (Dom' Term Type)
    delta (TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Functor m => m Doc -> m Doc
    brackets (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 ([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] -> [TCMT IO Doc]
    forall (m :: * -> *) (t :: * -> *).
    (Applicative m, Semigroup (m Doc), Foldable t) =>
    m Doc -> t (m Doc) -> [m Doc]
    punctuate TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc
    comma ([TCMT IO Doc] -> [TCMT IO Doc]) -> [TCMT IO Doc] -> [TCMT IO Doc]
    forall a b. (a -> b) -> a -> b
    $ (DotPattern -> TCMT IO Doc) -> [DotPattern] -> [TCMT IO Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map DotPattern -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM [DotPattern]
    dots)
                     , TCMT IO Doc
    "asb     = " TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> Tele (Dom' Term Type) -> TCMT IO Doc -> TCMT IO Doc
    forall b (m :: * -> *) a.
    (AddContext b, MonadAddContext m) =>
    b -> m a -> m a
    addContext Tele (Dom' Term Type)
    delta (TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Functor m => m Doc -> m Doc
    brackets (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 ([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] -> [TCMT IO Doc]
    forall (m :: * -> *) (t :: * -> *).
    (Applicative m, Semigroup (m Doc), Foldable t) =>
    m Doc -> t (m Doc) -> [m Doc]
    punctuate TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc
    comma ([TCMT IO Doc] -> [TCMT IO Doc]) -> [TCMT IO Doc] -> [TCMT IO Doc]
    forall a b. (a -> b) -> a -> b
    $ (AsBinding -> TCMT IO Doc) -> [AsBinding] -> [TCMT IO Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map AsBinding -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM [AsBinding]
    asb)
                     , TCMT IO Doc
    "absurds = " TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> Tele (Dom' Term Type) -> TCMT IO Doc -> TCMT IO Doc
    forall b (m :: * -> *) a.
    (AddContext b, MonadAddContext m) =>
    b -> m a -> m a
    addContext Tele (Dom' Term Type)
    delta (TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Functor m => m Doc -> m Doc
    brackets (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 ([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] -> [TCMT IO Doc]
    forall (m :: * -> *) (t :: * -> *).
    (Applicative m, Semigroup (m Doc), Foldable t) =>
    m Doc -> t (m Doc) -> [m Doc]
    punctuate TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc
    comma ([TCMT IO Doc] -> [TCMT IO Doc]) -> [TCMT IO Doc] -> [TCMT IO Doc]
    forall a b. (a -> b) -> a -> b
    $ (AbsurdPattern -> TCMT IO Doc) -> [AbsurdPattern] -> [TCMT IO Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map AbsurdPattern -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM [AbsurdPattern]
    absurds)
                     , TCMT IO Doc
    "qs      = " TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> Tele (Dom' Term Type) -> TCMT IO Doc -> TCMT IO Doc
    forall b (m :: * -> *) a.
    (AddContext b, MonadAddContext m) =>
    b -> m a -> m a
    addContext Tele (Dom' Term Type)
    delta ([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
    $ (NamedArg DeBruijnPattern -> TCMT IO Doc)
    -> [NamedArg DeBruijnPattern] -> [TCMT IO Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map NamedArg DeBruijnPattern -> TCMT IO Doc
    forall (m :: * -> *) a. (Applicative m, Pretty a) => a -> m Doc
    pretty [NamedArg DeBruijnPattern]
    qs)
                     ]
                   ]
            [Char] -> Int -> TCMT IO Doc -> TCMT IO ()
    forall (m :: * -> *).
    MonadDebug m =>
    [Char] -> Int -> TCMT IO Doc -> m ()
    reportSDoc [Char]
    "tc.lhs.top" Int
    30 (TCMT IO Doc -> TCMT IO ()) -> TCMT IO Doc -> TCMT IO ()
    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
    "vars   = " TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> [Maybe Name] -> TCMT IO Doc
    forall (m :: * -> *) a. (Applicative m, Pretty a) => a -> m Doc
    pretty [Maybe Name]
    vars
                     ]
            [Char] -> Int -> TCMT IO Doc -> TCMT IO ()
    forall (m :: * -> *).
    MonadDebug m =>
    [Char] -> Int -> TCMT IO Doc -> m ()
    reportSDoc [Char]
    "tc.lhs.top" Int
    20 (TCMT IO Doc -> TCMT IO ()) -> TCMT IO Doc -> TCMT IO ()
    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
    "withSub  = " TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> Substitution -> TCMT IO Doc
    forall (m :: * -> *) a. (Applicative m, Pretty a) => a -> m Doc
    pretty Substitution
    withSub
            [Char] -> Int -> TCMT IO Doc -> TCMT IO ()
    forall (m :: * -> *).
    MonadDebug m =>
    [Char] -> Int -> TCMT IO Doc -> m ()
    reportSDoc [Char]
    "tc.lhs.top" Int
    20 (TCMT IO Doc -> TCMT IO ()) -> TCMT IO Doc -> TCMT IO ()
    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
    "weakSub  = " TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> Substitution -> TCMT IO Doc
    forall (m :: * -> *) a. (Applicative m, Pretty a) => a -> m Doc
    pretty Substitution
    weakSub
            [Char] -> Int -> TCMT IO Doc -> TCMT IO ()
    forall (m :: * -> *).
    MonadDebug m =>
    [Char] -> Int -> TCMT IO Doc -> m ()
    reportSDoc [Char]
    "tc.lhs.top" Int
    20 (TCMT IO Doc -> TCMT IO ()) -> TCMT IO Doc -> TCMT IO ()
    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
    "patSub   = " TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> Substitution -> TCMT IO Doc
    forall (m :: * -> *) a. (Applicative m, Pretty a) => a -> m Doc
    pretty Substitution
    patSub
            [Char] -> Int -> TCMT IO Doc -> TCMT IO ()
    forall (m :: * -> *).
    MonadDebug m =>
    [Char] -> Int -> TCMT IO Doc -> m ()
    reportSDoc [Char]
    "tc.lhs.top" Int
    20 (TCMT IO Doc -> TCMT IO ()) -> TCMT IO Doc -> TCMT IO ()
    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
    "paramSub = " TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> Substitution -> TCMT IO Doc
    forall (m :: * -> *) a. (Applicative m, Pretty a) => a -> m Doc
    pretty Substitution
    paramSub

            Context
    newCxt <- [Maybe Name] -> Tele (Dom' Term Type) -> TCM Context
    computeLHSContext [Maybe Name]
    vars Tele (Dom' Term Type)
    delta

            Substitution -> (Context -> Context) -> TCMT IO a -> TCMT IO a
    forall (m :: * -> *) a.
    MonadAddContext m =>
    Substitution -> (Context -> Context) -> m a -> m a
    updateContext Substitution
    paramSub (Context -> Context -> Context
    forall a b. a -> b -> a
    const Context
    newCxt) (TCMT IO a -> TCMT IO a) -> TCMT IO a -> TCMT IO a
    forall a b. (a -> b) -> a -> b
    $ do

              [Char] -> Int -> TCMT IO Doc -> TCMT IO ()
    forall (m :: * -> *).
    MonadDebug m =>
    [Char] -> Int -> TCMT IO Doc -> m ()
    reportSDoc [Char]
    "tc.lhs.top" Int
    10 (TCMT IO Doc -> TCMT IO ()) -> TCMT IO Doc -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ TCMT IO Doc
    "bound pattern variables"
              [Char] -> Int -> TCMT IO Doc -> TCMT IO ()
    forall (m :: * -> *).
    MonadDebug m =>
    [Char] -> Int -> TCMT IO Doc -> m ()
    reportSDoc [Char]
    "tc.lhs.top" Int
    60 (TCMT IO Doc -> TCMT IO ()) -> TCMT IO Doc -> TCMT IO ()
    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
    "context = " TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> (Tele (Dom' Term Type) -> TCMT IO Doc
    forall (m :: * -> *) a. (Applicative m, Pretty a) => a -> m Doc
    pretty (Tele (Dom' Term Type) -> TCMT IO Doc)
    -> TCMT IO (Tele (Dom' Term Type)) -> TCMT IO Doc
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< TCMT IO (Tele (Dom' Term Type))
    forall (m :: * -> *).
    (Applicative m, MonadTCEnv m) =>
    m (Tele (Dom' Term Type))
    getContextTelescope)
              [Char] -> Int -> TCMT IO Doc -> TCMT IO ()
    forall (m :: * -> *).
    MonadDebug m =>
    [Char] -> Int -> TCMT IO Doc -> m ()
    reportSDoc [Char]
    "tc.lhs.top" Int
    10 (TCMT IO Doc -> TCMT IO ()) -> TCMT IO Doc -> TCMT IO ()
    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
    "type  = " TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> Arg Type -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM Arg Type
    b
              [Char] -> Int -> TCMT IO Doc -> TCMT IO ()
    forall (m :: * -> *).
    MonadDebug m =>
    [Char] -> Int -> TCMT IO Doc -> m ()
    reportSDoc [Char]
    "tc.lhs.top" Int
    60 (TCMT IO Doc -> TCMT IO ()) -> TCMT IO Doc -> TCMT IO ()
    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
    "type  = " TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> Arg Type -> TCMT IO Doc
    forall (m :: * -> *) a. (Applicative m, Pretty a) => a -> m Doc
    pretty Arg Type
    b

              [AsBinding] -> TCMT IO () -> TCMT IO ()
    forall a. [AsBinding] -> TCM a -> TCM a
    bindAsPatterns [AsBinding]
    asb (TCMT IO () -> TCMT IO ()) -> TCMT IO () -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ do

                -- Check dot patterns
                (DotPattern -> TCMT IO ()) -> [DotPattern] -> TCMT IO ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ DotPattern -> TCMT IO ()
    checkDotPattern [DotPattern]
    dots
                (AbsurdPattern -> TCMT IO ()) -> [AbsurdPattern] -> TCMT IO ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ AbsurdPattern -> TCMT IO ()
    checkAbsurdPattern [AbsurdPattern]
    absurds
                (AnnotationPattern -> TCMT IO ())
    -> [AnnotationPattern] -> TCMT IO ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ AnnotationPattern -> TCMT IO ()
    checkAnnotationPattern [AnnotationPattern]
    annps

              -- Issue2303: don't bind asb' for the continuation (return in lhsResult instead)
              LHSResult -> TCMT IO a
    ret LHSResult
    lhsResult

      LHSState a
    st0 <- Tele (Dom' Term Type)
    -> [ProblemEq]
    -> [NamedArg Pattern]
    -> Type
    -> (LHSState a -> TCMT IO a)
    -> TCM (LHSState a)
    forall a.
    Tele (Dom' Term Type)
    -> [ProblemEq]
    -> [NamedArg Pattern]
    -> Type
    -> (LHSState a -> TCM a)
    -> TCM (LHSState a)
    initLHSState Tele (Dom' Term Type)
    tel [ProblemEq]
    eqs0 [NamedArg Pattern]
    ps Type
    a LHSState a -> TCMT IO a
    finalChecks

      -- after we have introduced variables, we can add the patterns stripped by
      -- with-desugaring to the state.
      let withSub :: Substitution
    withSub = Substitution -> Maybe Substitution -> Substitution
    forall a. a -> Maybe a -> a
    fromMaybe Substitution
    forall a. HasCallStack => a
    __IMPOSSIBLE__ Maybe Substitution
    withSub'
      [ProblemEq]
    withEqs <- [ProblemEq] -> TCMT IO [ProblemEq]
    updateProblemEqs ([ProblemEq] -> TCMT IO [ProblemEq])
    -> [ProblemEq] -> TCMT IO [ProblemEq]
    forall a b. (a -> b) -> a -> b
    $ Substitution' (SubstArg [ProblemEq]) -> [ProblemEq] -> [ProblemEq]
    forall a. Subst a => Substitution' (SubstArg a) -> a -> a
    applySubst Substitution
    Substitution' (SubstArg [ProblemEq])
    withSub [ProblemEq]
    strippedPats
      -- Jesper, 2017-05-13: re-check the stripped patterns here!
      TCMT IO () -> TCMT IO ()
    forall (tcm :: * -> *) a.
    (MonadTCEnv tcm, ReadTCState tcm) =>
    tcm a -> tcm a
    inTopContext (TCMT IO () -> TCMT IO ()) -> TCMT IO () -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ Tele (Dom' Term Type) -> TCMT IO () -> TCMT IO ()
    forall b (m :: * -> *) a.
    (AddContext b, MonadAddContext m) =>
    b -> m a -> m a
    addContext (LHSState a
    st0 LHSState a
    -> Lens' (Tele (Dom' Term Type)) (LHSState a)
    -> Tele (Dom' Term Type)
    forall o i. o -> Lens' i o -> i
    ^. forall a. Lens' (Tele (Dom' Term Type)) (LHSState a)
    Lens' (Tele (Dom' Term Type)) (LHSState a)
    lhsTel) (TCMT IO () -> TCMT IO ()) -> TCMT IO () -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $
        [ProblemEq] -> (ProblemEq -> TCMT IO ()) -> TCMT IO ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    t a -> (a -> m b) -> m ()
    forM_ [ProblemEq]
    withEqs ProblemEq -> TCMT IO ()
    recheckStrippedWithPattern

      let st :: LHSState a
    st = Lens' [ProblemEq] (LHSState a) -> LensMap [ProblemEq] (LHSState a)
    forall i o. Lens' i o -> LensMap i o
    over ((Problem a -> f (Problem a)) -> LHSState a -> f (LHSState a)
    forall a. Lens' (Problem a) (LHSState a)
    lhsProblem ((Problem a -> f (Problem a)) -> LHSState a -> f (LHSState a))
    -> (([ProblemEq] -> f [ProblemEq]) -> Problem a -> f (Problem a))
    -> ([ProblemEq] -> f [ProblemEq])
    -> LHSState a
    -> f (LHSState a)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ([ProblemEq] -> f [ProblemEq]) -> Problem a -> f (Problem a)
    forall a. Lens' [ProblemEq] (Problem a)
    problemEqs) ([ProblemEq] -> [ProblemEq] -> [ProblemEq]
    forall a. [a] -> [a] -> [a]
    ++ [ProblemEq]
    withEqs) LHSState a
    st0

      -- doing the splits:
      (a
    result, Blocked' Term ()
    block) <- TCMT IO (a, Blocked' Term ()) -> TCMT IO (a, Blocked' Term ())
    forall (tcm :: * -> *) a.
    (MonadTCEnv tcm, ReadTCState tcm) =>
    tcm a -> tcm a
    unsafeInTopContext (TCMT IO (a, Blocked' Term ()) -> TCMT IO (a, Blocked' Term ()))
    -> TCMT IO (a, Blocked' Term ()) -> TCMT IO (a, Blocked' Term ())
    forall a b. (a -> b) -> a -> b
    $ WriterT (Blocked' Term ()) (TCMT IO) a
    -> TCMT IO (a, Blocked' Term ())
    forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
    runWriterT (WriterT (Blocked' Term ()) (TCMT IO) a
     -> TCMT IO (a, Blocked' Term ()))
    -> WriterT (Blocked' Term ()) (TCMT IO) a
    -> TCMT IO (a, Blocked' Term ())
    forall a b. (a -> b) -> a -> b
    $ (ReaderT Int (WriterT (Blocked' Term ()) (TCMT IO)) a
    -> Int -> WriterT (Blocked' Term ()) (TCMT IO) a
    forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
    `runReaderT` (Context -> Int
    forall a. Sized a => a -> Int
    size Context
    cxt)) (ReaderT Int (WriterT (Blocked' Term ()) (TCMT IO)) a
     -> WriterT (Blocked' Term ()) (TCMT IO) a)
    -> ReaderT Int (WriterT (Blocked' Term ()) (TCMT IO)) a
    -> WriterT (Blocked' Term ()) (TCMT IO) a
    forall a b. (a -> b) -> a -> b
    $ Maybe QName
    -> LHSState a
    -> ReaderT Int (WriterT (Blocked' Term ()) (TCMT IO)) a
    forall (tcm :: * -> *) a.
    (MonadTCM tcm, PureTCM tcm, MonadWriter (Blocked' Term ()) tcm,
     MonadError TCErr tcm, MonadTrace tcm, MonadReader Int tcm) =>
    Maybe QName -> LHSState a -> tcm a
    checkLHS Maybe QName
    f LHSState a
    st
      a -> TCMT IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return a
    result

    -- | Determine which splits should be tried.
    splitStrategy :: [ProblemEq] -> [ProblemEq]
    splitStrategy :: [ProblemEq] -> [ProblemEq]
    splitStrategy = (ProblemEq -> Bool) -> [ProblemEq] -> [ProblemEq]
    forall a. (a -> Bool) -> [a] -> [a]
    filter ProblemEq -> Bool
    shouldSplit
      where
        shouldSplit :: ProblemEq -> Bool
        shouldSplit :: ProblemEq -> Bool
    shouldSplit problem :: ProblemEq
    problem@(ProblemEq Pattern
    p Term
    v Dom' Term Type
    a) = case Pattern
    p of
          A.LitP{}    -> Bool
    True
          A.RecP{}    -> Bool
    True
          A.ConP{}    -> Bool
    True
          A.EqualP{}  -> Bool
    True

          A.VarP{}    -> Bool
    False
          A.WildP{}   -> Bool
    False
          A.DotP{}    -> Bool
    False
          A.AbsurdP{} -> Bool
    False

          A.AsP PatInfo
    _ BindName
    _ Pattern
    p  -> ProblemEq -> Bool
    shouldSplit (ProblemEq -> Bool) -> ProblemEq -> Bool
    forall a b. (a -> b) -> a -> b
    $ ProblemEq
    problem { problemInPat :: Pattern
    problemInPat = Pattern
    p }
          A.AnnP PatInfo
    _ Expr
    _ Pattern
    p -> ProblemEq -> Bool
    shouldSplit (ProblemEq -> Bool) -> ProblemEq -> Bool
    forall a b. (a -> b) -> a -> b
    $ ProblemEq
    problem { problemInPat :: Pattern
    problemInPat = Pattern
    p }

          A.ProjP{}       -> Bool
    forall a. HasCallStack => a
    __IMPOSSIBLE__
          A.DefP{}        -> Bool
    forall a. HasCallStack => a
    __IMPOSSIBLE__
          A.PatternSynP{} -> Bool
    forall a. HasCallStack => a
    __IMPOSSIBLE__
          A.WithP{}       -> Bool
    forall a. HasCallStack => a
    __IMPOSSIBLE__

    -- | The loop (tail-recursive): split at a variable in the problem until problem is solved
    checkLHS
      :: forall tcm a. (MonadTCM tcm, PureTCM tcm, MonadWriter Blocked_ tcm, MonadError TCErr tcm, MonadTrace tcm, MonadReader Nat tcm)
      => Maybe QName      -- ^ The name of the definition we are checking.
      -> LHSState a       -- ^ The current state.
      -> tcm a
    checkLHS :: forall (tcm :: * -> *) a.
    (MonadTCM tcm, PureTCM tcm, MonadWriter (Blocked' Term ()) tcm,
     MonadError TCErr tcm, MonadTrace tcm, MonadReader Int tcm) =>
    Maybe QName -> LHSState a -> tcm a
    checkLHS Maybe QName
    mf = (LHSState a -> tcm a) -> LHSState a -> tcm a
    forall {tcm :: * -> *} {a} {a}.
    MonadTCEnv tcm =>
    (LHSState a -> tcm a) -> LHSState a -> tcm a
    updateModality LHSState a -> tcm a
    checkLHS_ where
        -- If the target type is irrelevant or in Prop,
        -- we need to check the lhs in irr. cxt. (see Issue 939).
     updateModality :: (LHSState a -> tcm a) -> LHSState a -> tcm a
    updateModality LHSState a -> tcm a
    cont st :: LHSState a
    st@(LHSState Tele (Dom' Term Type)
    tel [NamedArg DeBruijnPattern]
    ip Problem a
    problem Arg Type
    target [Maybe Int]
    psplit) = do
          let m :: Modality
    m = Arg Type -> Modality
    forall a. LensModality a => a -> Modality
    getModality Arg Type
    target
          Modality -> tcm a -> tcm a
    forall (tcm :: * -> *) m a.
    (MonadTCEnv tcm, LensModality m) =>
    m -> tcm a -> tcm a
    applyModalityToContext Modality
    m (tcm a -> tcm a) -> tcm a -> tcm a
    forall a b. (a -> b) -> a -> b
    $ do
            LHSState a -> tcm a
    cont (LHSState a -> tcm a) -> LHSState a -> tcm a
    forall a b. (a -> b) -> a -> b
    $ Lens' [Dom ([Char], Type)] (LHSState a)
    -> LensMap [Dom ([Char], Type)] (LHSState a)
    forall i o. Lens' i o -> LensMap i o
    over ((Tele (Dom' Term Type) -> f (Tele (Dom' Term Type)))
    -> LHSState a -> f (LHSState a)
    forall a. Lens' (Tele (Dom' Term Type)) (LHSState a)
    lhsTel ((Tele (Dom' Term Type) -> f (Tele (Dom' Term Type)))
     -> LHSState a -> f (LHSState a))
    -> (([Dom ([Char], Type)] -> f [Dom ([Char], Type)])
        -> Tele (Dom' Term Type) -> f (Tele (Dom' Term Type)))
    -> ([Dom ([Char], Type)] -> f [Dom ([Char], Type)])
    -> LHSState a
    -> f (LHSState a)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ([Dom ([Char], Type)] -> f [Dom ([Char], Type)])
    -> Tele (Dom' Term Type) -> f (Tele (Dom' Term Type))
    Lens' [Dom ([Char], Type)] (Tele (Dom' Term Type))
    listTel)
                     ((Dom ([Char], Type) -> Dom ([Char], Type))
    -> [Dom ([Char], Type)] -> [Dom ([Char], Type)]
    forall a b. (a -> b) -> [a] -> [b]
    map ((Dom ([Char], Type) -> Dom ([Char], Type))
     -> [Dom ([Char], Type)] -> [Dom ([Char], Type)])
    -> (Dom ([Char], Type) -> Dom ([Char], Type))
    -> [Dom ([Char], Type)]
    -> [Dom ([Char], Type)]
    forall a b. (a -> b) -> a -> b
    $ Modality -> Dom ([Char], Type) -> Dom ([Char], Type)
    forall a. LensModality a => Modality -> a -> a
    inverseApplyModalityButNotQuantity Modality
    m) LHSState a
    st
            -- Andreas, 2018-10-23, issue #3309
            -- the modalities in the clause telescope also need updating.

     checkLHS_ :: LHSState a -> tcm a
    checkLHS_ st :: LHSState a
    st@(LHSState Tele (Dom' Term Type)
    tel [NamedArg DeBruijnPattern]
    ip Problem a
    problem Arg Type
    target [Maybe Int]
    psplit) = do
      [Char] -> Int -> TCMT IO Doc -> tcm ()
    forall (m :: * -> *).
    MonadDebug m =>
    [Char] -> Int -> TCMT IO Doc -> m ()
    reportSDoc [Char]
    "lhs" Int
    10 (TCMT IO Doc -> tcm ()) -> TCMT IO Doc -> tcm ()
    forall a b. (a -> b) -> a -> b
    $ TCMT IO Doc
    "tel is" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> Tele (Dom' Term Type) -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM Tele (Dom' Term Type)
    tel
      [Char] -> Int -> TCMT IO Doc -> tcm ()
    forall (m :: * -> *).
    MonadDebug m =>
    [Char] -> Int -> TCMT IO Doc -> m ()
    reportSDoc [Char]
    "lhs" Int
    10 (TCMT IO Doc -> tcm ()) -> TCMT IO Doc -> tcm ()
    forall a b. (a -> b) -> a -> b
    $ TCMT IO Doc
    "ip is" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> [NamedArg DeBruijnPattern] -> TCMT IO Doc
    forall (m :: * -> *) a. (Applicative m, Pretty a) => a -> m Doc
    pretty [NamedArg DeBruijnPattern]
    ip
      if Problem a -> Bool
    forall a. Problem a -> Bool
    isSolvedProblem Problem a
    problem then
        TCM a -> tcm a
    forall (tcm :: * -> *) a. MonadTCM tcm => TCM a -> tcm a
    liftTCM (TCM a -> tcm a) -> TCM a -> tcm a
    forall a b. (a -> b) -> a -> b
    $ (Problem a
    problem Problem a
    -> Lens' (LHSState a -> TCM a) (Problem a) -> LHSState a -> TCM a
    forall o i. o -> Lens' i o -> i
    ^. forall a. Lens' (LHSState a -> TCM a) (Problem a)
    Lens' (LHSState a -> TCM a) (Problem a)
    problemCont) LHSState a
    st
      else do

        [Char] -> Int -> TCMT IO Doc -> tcm ()
    forall (m :: * -> *).
    MonadDebug m =>
    [Char] -> Int -> TCMT IO Doc -> m ()
    reportSDoc [Char]
    "tc.lhs.top" Int
    30 (TCMT IO Doc -> tcm ()) -> TCMT IO Doc -> tcm ()
    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
    "LHS state: " , Int -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Functor m => Int -> m Doc -> m Doc
    nest Int
    2 (LHSState a -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM LHSState a
    st) ]

        tcm Bool -> tcm () -> tcm ()
    forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
    unlessM (PragmaOptions -> Bool
    optPatternMatching (PragmaOptions -> Bool) -> tcm PragmaOptions -> tcm Bool
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (TCState -> PragmaOptions) -> tcm PragmaOptions
    forall (m :: * -> *) a. ReadTCState m => (TCState -> a) -> m a
    getsTC TCState -> PragmaOptions
    forall a. LensPragmaOptions a => a -> PragmaOptions
    getPragmaOptions) (tcm () -> tcm ()) -> tcm () -> tcm ()
    forall a b. (a -> b) -> a -> b
    $
          Bool -> tcm () -> tcm ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless (Problem a -> Bool
    forall a. Problem a -> Bool
    problemAllVariables Problem a
    problem) (tcm () -> tcm ()) -> tcm () -> tcm ()
    forall a b. (a -> b) -> a -> b
    $
            TypeError -> tcm ()
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCError m) =>
    TypeError -> m a
    typeError (TypeError -> tcm ()) -> TypeError -> tcm ()
    forall a b. (a -> b) -> a -> b
    $ [Char] -> TypeError
    GenericError ([Char] -> TypeError) -> [Char] -> TypeError
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "Pattern matching is disabled"

        let splitsToTry :: [ProblemEq]
    splitsToTry = [ProblemEq] -> [ProblemEq]
    splitStrategy ([ProblemEq] -> [ProblemEq]) -> [ProblemEq] -> [ProblemEq]
    forall a b. (a -> b) -> a -> b
    $ Problem a
    problem Problem a -> Lens' [ProblemEq] (Problem a) -> [ProblemEq]
    forall o i. o -> Lens' i o -> i
    ^. forall a. Lens' [ProblemEq] (Problem a)
    Lens' [ProblemEq] (Problem a)
    problemEqs

        (ProblemEq
     -> tcm (Either [TCErr] (LHSState a))
     -> tcm (Either [TCErr] (LHSState a)))
    -> tcm (Either [TCErr] (LHSState a))
    -> [ProblemEq]
    -> tcm (Either [TCErr] (LHSState a))
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr ProblemEq
    -> tcm (Either [TCErr] (LHSState a))
    -> tcm (Either [TCErr] (LHSState a))
    trySplit tcm (Either [TCErr] (LHSState a))
    trySplitRest [ProblemEq]
    splitsToTry tcm (Either [TCErr] (LHSState a))
    -> (Either [TCErr] (LHSState a) -> tcm a) -> tcm a
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \case
          Right LHSState a
    st' -> Maybe QName -> LHSState a -> tcm a
    forall (tcm :: * -> *) a.
    (MonadTCM tcm, PureTCM tcm, MonadWriter (Blocked' Term ()) tcm,
     MonadError TCErr tcm, MonadTrace tcm, MonadReader Int tcm) =>
    Maybe QName -> LHSState a -> tcm a
    checkLHS Maybe QName
    mf LHSState a
    st'
          -- If no split works, give error from first split.
          -- This is conservative, but might not be the best behavior.
          -- It might be better to print all the errors instead.
          Left (TCErr
    err:[TCErr]
    _) -> TCErr -> tcm a
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError TCErr
    err
          Left []      -> tcm a
    forall a. HasCallStack => a
    __IMPOSSIBLE__

      where

        trySplit :: ProblemEq
                 -> tcm (Either [TCErr] (LHSState a))
                 -> tcm (Either [TCErr] (LHSState a))
        trySplit :: ProblemEq
    -> tcm (Either [TCErr] (LHSState a))
    -> tcm (Either [TCErr] (LHSState a))
    trySplit ProblemEq
    eq tcm (Either [TCErr] (LHSState a))
    tryNextSplit = ExceptT TCErr tcm (LHSState a) -> tcm (Either TCErr (LHSState a))
    forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
    runExceptT (ProblemEq -> ExceptT TCErr tcm (LHSState a)
    splitArg ProblemEq
    eq) tcm (Either TCErr (LHSState a))
    -> (Either TCErr (LHSState a) -> tcm (Either [TCErr] (LHSState a)))
    -> tcm (Either [TCErr] (LHSState a))
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \case
          Right LHSState a
    st' -> Either [TCErr] (LHSState a) -> tcm (Either [TCErr] (LHSState a))
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Either [TCErr] (LHSState a) -> tcm (Either [TCErr] (LHSState a)))
    -> Either [TCErr] (LHSState a) -> tcm (Either [TCErr] (LHSState a))
    forall a b. (a -> b) -> a -> b
    $ LHSState a -> Either [TCErr] (LHSState a)
    forall a b. b -> Either a b
    Right LHSState a
    st'
          Left TCErr
    err  -> ([TCErr] -> [TCErr])
    -> Either [TCErr] (LHSState a) -> Either [TCErr] (LHSState a)
    forall (a :: * -> * -> *) b c d.
    ArrowChoice a =>
    a b c -> a (Either b d) (Either c d)
    left (TCErr
    errTCErr -> [TCErr] -> [TCErr]
    forall a. a -> [a] -> [a]
    :) (Either [TCErr] (LHSState a) -> Either [TCErr] (LHSState a))
    -> tcm (Either [TCErr] (LHSState a))
    -> tcm (Either [TCErr] (LHSState a))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> tcm (Either [TCErr] (LHSState a))
    tryNextSplit

        -- If there are any remaining user patterns, try to split on them
        trySplitRest :: tcm (Either [TCErr] (LHSState a))
        trySplitRest :: tcm (Either [TCErr] (LHSState a))
    trySplitRest = case Problem a
    problem Problem a
    -> Lens' [NamedArg Pattern] (Problem a) -> [NamedArg Pattern]
    forall o i. o -> Lens' i o -> i
    ^. forall a. Lens' [NamedArg Pattern] (Problem a)
    Lens' [NamedArg Pattern] (Problem a)
    problemRestPats of
          []    -> Either [TCErr] (LHSState a) -> tcm (Either [TCErr] (LHSState a))
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Either [TCErr] (LHSState a) -> tcm (Either [TCErr] (LHSState a)))
    -> Either [TCErr] (LHSState a) -> tcm (Either [TCErr] (LHSState a))
    forall a b. (a -> b) -> a -> b
    $ [TCErr] -> Either [TCErr] (LHSState a)
    forall a b. a -> Either a b
    Left []
          (NamedArg Pattern
    p:[NamedArg Pattern]
    _) -> (TCErr -> [TCErr])
    -> Either TCErr (LHSState a) -> Either [TCErr] (LHSState a)
    forall (a :: * -> * -> *) b c d.
    ArrowChoice a =>
    a b c -> a (Either b d) (Either c d)
    left TCErr -> [TCErr]
    forall el coll. Singleton el coll => el -> coll
    singleton (Either TCErr (LHSState a) -> Either [TCErr] (LHSState a))
    -> tcm (Either TCErr (LHSState a))
    -> tcm (Either [TCErr] (LHSState a))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ExceptT TCErr tcm (LHSState a) -> tcm (Either TCErr (LHSState a))
    forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
    runExceptT (NamedArg Pattern -> ExceptT TCErr tcm (LHSState a)
    splitRest NamedArg Pattern
    p)

        splitArg :: ProblemEq -> ExceptT TCErr tcm (LHSState a)
        -- Split on constructor/literal pattern
        splitArg :: ProblemEq -> ExceptT TCErr tcm (LHSState a)
    splitArg (ProblemEq Pattern
    p Term
    v Dom{unDom :: forall t e. Dom' t e -> e
    unDom = Type
    a}) = Call
    -> ExceptT TCErr tcm (LHSState a) -> ExceptT TCErr tcm (LHSState a)
    forall (m :: * -> *) a. MonadTrace m => Call -> m a -> m a
    traceCall (Pattern -> Tele (Dom' Term Type) -> Type -> Call
    CheckPattern Pattern
    p Tele (Dom' Term Type)
    tel Type
    a) (ExceptT TCErr tcm (LHSState a) -> ExceptT TCErr tcm (LHSState a))
    -> ExceptT TCErr tcm (LHSState a) -> ExceptT TCErr tcm (LHSState a)
    forall a b. (a -> b) -> a -> b
    $ do

          [Char] -> Int -> TCMT IO Doc -> ExceptT TCErr tcm ()
    forall (m :: * -> *).
    MonadDebug m =>
    [Char] -> Int -> TCMT IO Doc -> m ()
    reportSDoc [Char]
    "tc.lhs.split" Int
    30 (TCMT IO Doc -> ExceptT TCErr tcm ())
    -> TCMT IO Doc -> ExceptT TCErr tcm ()
    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
    "split looking at pattern"
            , 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
    "p =" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> Pattern -> TCMT IO Doc
    forall a (m :: * -> *).
    (ToConcrete a, Pretty (ConOfAbs a), MonadAbsToCon m) =>
    a -> m Doc
    prettyA Pattern
    p
            ]

          -- in order to split, v must be a variable.
          Int
    i <- TCM Int -> ExceptT TCErr tcm Int
    forall (tcm :: * -> *) a. MonadTCM tcm => TCM a -> tcm a
    liftTCM (TCM Int -> ExceptT TCErr tcm Int)
    -> TCM Int -> ExceptT TCErr tcm Int
    forall a b. (a -> b) -> a -> b
    $ Tele (Dom' Term Type) -> TCM Int -> TCM Int
    forall b (m :: * -> *) a.
    (AddContext b, MonadAddContext m) =>
    b -> m a -> m a
    addContext Tele (Dom' Term Type)
    tel (TCM Int -> TCM Int) -> TCM Int -> TCM Int
    forall a b. (a -> b) -> a -> b
    $ TCMT IO (Maybe Int) -> (Int -> TCM Int) -> TCM Int -> TCM Int
    forall (m :: * -> *) a b.
    Monad m =>
    m (Maybe a) -> (a -> m b) -> m b -> m b
    ifJustM (Term -> Type -> TCMT IO (Maybe Int)
    forall (m :: * -> *). PureTCM m => Term -> Type -> m (Maybe Int)
    isEtaVar Term
    v Type
    a) Int -> TCM Int
    forall (m :: * -> *) a. Monad m => a -> m a
    return (TCM Int -> TCM Int) -> TCM Int -> TCM Int
    forall a b. (a -> b) -> a -> b
    $
                 TypeError -> TCM Int
    forall (m :: * -> *) a.
    (HasCallStack, ReadTCState m, MonadError TCErr m, MonadTCEnv m) =>
    TypeError -> m a
    softTypeError (TypeError -> TCM Int) -> TypeError -> TCM Int
    forall a b. (a -> b) -> a -> b
    $ Term -> Type -> TypeError
    SplitOnNonVariable Term
    v Type
    a

          let pos :: Int
    pos = Tele (Dom' Term Type) -> Int
    forall a. Sized a => a -> Int
    size Tele (Dom' Term Type)
    tel Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - (Int
    iInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    1)
              (Tele (Dom' Term Type)
    delta1, tel' :: Tele (Dom' Term Type)
    tel'@(ExtendTel Dom' Term Type
    dom Abs (Tele (Dom' Term Type))
    adelta2)) = Int
    -> Tele (Dom' Term Type)
    -> (Tele (Dom' Term Type), Tele (Dom' Term Type))
    splitTelescopeAt Int
    pos Tele (Dom' Term Type)
    tel -- TODO:: tel' defined but not used

          Pattern
    p <- TCMT IO Pattern -> ExceptT TCErr tcm Pattern
    forall (tcm :: * -> *) a. MonadTCM tcm => TCM a -> tcm a
    liftTCM (TCMT IO Pattern -> ExceptT TCErr tcm Pattern)
    -> TCMT IO Pattern -> ExceptT TCErr tcm Pattern
    forall a b. (a -> b) -> a -> b
    $ Pattern -> TCMT IO Pattern
    forall (m :: * -> *).
    (MonadError TCErr m, MonadTCEnv m, ReadTCState m, HasBuiltins m) =>
    Pattern -> m Pattern
    expandLitPattern Pattern
    p
          let splitOnPat :: Pattern -> ExceptT TCErr tcm (LHSState a)
    splitOnPat = \case
                (A.LitP PatInfo
    _ Literal
    l)      -> Tele (Dom' Term Type)
    -> Dom' Term Type
    -> Abs (Tele (Dom' Term Type))
    -> Literal
    -> ExceptT TCErr tcm (LHSState a)
    splitLit Tele (Dom' Term Type)
    delta1 Dom' Term Type
    dom Abs (Tele (Dom' Term Type))
    adelta2 Literal
    l
                p :: Pattern
    p@A.RecP{}        -> Tele (Dom' Term Type)
    -> Dom' Term Type
    -> Abs (Tele (Dom' Term Type))
    -> Pattern
    -> Maybe AmbiguousQName
    -> ExceptT TCErr tcm (LHSState a)
    splitCon Tele (Dom' Term Type)
    delta1 Dom' Term Type
    dom Abs (Tele (Dom' Term Type))
    adelta2 Pattern
    p Maybe AmbiguousQName
    forall a. Maybe a
    Nothing
                p :: Pattern
    p@(A.ConP ConPatInfo
    _ AmbiguousQName
    c [NamedArg Pattern]
    ps) -> Tele (Dom' Term Type)
    -> Dom' Term Type
    -> Abs (Tele (Dom' Term Type))
    -> Pattern
    -> Maybe AmbiguousQName
    -> ExceptT TCErr tcm (LHSState a)
    splitCon Tele (Dom' Term Type)
    delta1 Dom' Term Type
    dom Abs (Tele (Dom' Term Type))
    adelta2 Pattern
    p (Maybe AmbiguousQName -> ExceptT TCErr tcm (LHSState a))
    -> Maybe AmbiguousQName -> ExceptT TCErr tcm (LHSState a)
    forall a b. (a -> b) -> a -> b
    $ AmbiguousQName -> Maybe AmbiguousQName
    forall a. a -> Maybe a
    Just AmbiguousQName
    c
                p :: Pattern
    p@(A.EqualP PatInfo
    _ [(Expr, Expr)]
    ts) -> Tele (Dom' Term Type)
    -> Dom' Term Type
    -> Abs (Tele (Dom' Term Type))
    -> [(Expr, Expr)]
    -> ExceptT TCErr tcm (LHSState a)
    splitPartial Tele (Dom' Term Type)
    delta1 Dom' Term Type
    dom Abs (Tele (Dom' Term Type))
    adelta2 [(Expr, Expr)]
    ts
                A.AsP PatInfo
    _ BindName
    _ Pattern
    p       -> Pattern -> ExceptT TCErr tcm (LHSState a)
    splitOnPat Pattern
    p
                A.AnnP PatInfo
    _ Expr
    _ Pattern
    p      -> Pattern -> ExceptT TCErr tcm (LHSState a)
    splitOnPat Pattern
    p

                A.VarP{}        -> ExceptT TCErr tcm (LHSState a)
    forall a. HasCallStack => a
    __IMPOSSIBLE__
                A.WildP{}       -> ExceptT TCErr tcm (LHSState a)
    forall a. HasCallStack => a
    __IMPOSSIBLE__
                A.DotP{}        -> ExceptT TCErr tcm (LHSState a)
    forall a. HasCallStack => a
    __IMPOSSIBLE__
                A.AbsurdP{}     -> ExceptT TCErr tcm (LHSState a)
    forall a. HasCallStack => a
    __IMPOSSIBLE__
                A.ProjP{}       -> ExceptT TCErr tcm (LHSState a)
    forall a. HasCallStack => a
    __IMPOSSIBLE__
                A.DefP{}        -> ExceptT TCErr tcm (LHSState a)
    forall a. HasCallStack => a
    __IMPOSSIBLE__
                A.PatternSynP{} -> ExceptT TCErr tcm (LHSState a)
    forall a. HasCallStack => a
    __IMPOSSIBLE__
                A.WithP{}       -> ExceptT TCErr tcm (LHSState a)
    forall a. HasCallStack => a
    __IMPOSSIBLE__
          Pattern -> ExceptT TCErr tcm (LHSState a)
    splitOnPat Pattern
    p

        splitRest :: NamedArg A.Pattern -> ExceptT TCErr tcm (LHSState a)
        splitRest :: NamedArg Pattern -> ExceptT TCErr tcm (LHSState a)
    splitRest NamedArg Pattern
    p = NamedArg Pattern
    -> ExceptT TCErr tcm (LHSState a) -> ExceptT TCErr tcm (LHSState a)
    forall (m :: * -> *) x a.
    (MonadTrace m, HasRange x) =>
    x -> m a -> m a
    setCurrentRange NamedArg Pattern
    p (ExceptT TCErr tcm (LHSState a) -> ExceptT TCErr tcm (LHSState a))
    -> ExceptT TCErr tcm (LHSState a) -> ExceptT TCErr tcm (LHSState a)
    forall a b. (a -> b) -> a -> b
    $ do
          [Char] -> Int -> TCMT IO Doc -> ExceptT TCErr tcm ()
    forall (m :: * -> *).
    MonadDebug m =>
    [Char] -> Int -> TCMT IO Doc -> m ()
    reportSDoc [Char]
    "tc.lhs.split" Int
    20 (TCMT IO Doc -> ExceptT TCErr tcm ())
    -> TCMT IO Doc -> ExceptT TCErr tcm ()
    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
    "splitting problem rest"
            , 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
    "projection pattern =" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> NamedArg Pattern -> TCMT IO Doc
    forall a (m :: * -> *).
    (ToConcrete a, Pretty (ConOfAbs a), MonadAbsToCon m) =>
    a -> m Doc
    prettyA NamedArg Pattern
    p
            , 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
    "eliminates type    =" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> Arg Type -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM Arg Type
    target
            ]
          [Char] -> Int -> TCMT IO Doc -> ExceptT TCErr tcm ()
    forall (m :: * -> *).
    MonadDebug m =>
    [Char] -> Int -> TCMT IO Doc -> m ()
    reportSDoc [Char]
    "tc.lhs.split" Int
    80 (TCMT IO Doc -> ExceptT TCErr tcm ())
    -> TCMT IO Doc -> ExceptT TCErr tcm ()
    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
            [ 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
    $ [Char] -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => [Char] -> m Doc
    text ([Char] -> TCMT IO Doc) -> [Char] -> TCMT IO Doc
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "projection pattern (raw) = " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ NamedArg Pattern -> [Char]
    forall a. Show a => a -> [Char]
    show NamedArg Pattern
    p
            ]

          -- @p@ should be a projection pattern projection from @target@
          (ProjOrigin
    orig, AmbiguousQName
    ambProjName) <- Maybe (ProjOrigin, AmbiguousQName)
    -> ((ProjOrigin, AmbiguousQName)
        -> ExceptT TCErr tcm (ProjOrigin, AmbiguousQName))
    -> ExceptT TCErr tcm (ProjOrigin, AmbiguousQName)
    -> ExceptT TCErr tcm (ProjOrigin, AmbiguousQName)
    forall a b. Maybe a -> (a -> b) -> b -> b
    ifJust (NamedArg Pattern -> Maybe (ProjOrigin, AmbiguousQName)
    forall a. IsProjP a => a -> Maybe (ProjOrigin, AmbiguousQName)
    A.isProjP NamedArg Pattern
    p) (ProjOrigin, AmbiguousQName)
    -> ExceptT TCErr tcm (ProjOrigin, AmbiguousQName)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (ExceptT TCErr tcm (ProjOrigin, AmbiguousQName)
     -> ExceptT TCErr tcm (ProjOrigin, AmbiguousQName))
    -> ExceptT TCErr tcm (ProjOrigin, AmbiguousQName)
    -> ExceptT TCErr tcm (ProjOrigin, AmbiguousQName)
    forall a b. (a -> b) -> a -> b
    $ Tele (Dom' Term Type)
    -> ExceptT TCErr tcm (ProjOrigin, AmbiguousQName)
    -> ExceptT TCErr tcm (ProjOrigin, AmbiguousQName)
    forall b (m :: * -> *) a.
    (AddContext b, MonadAddContext m) =>
    b -> m a -> m a
    addContext Tele (Dom' Term Type)
    tel (ExceptT TCErr tcm (ProjOrigin, AmbiguousQName)
     -> ExceptT TCErr tcm (ProjOrigin, AmbiguousQName))
    -> ExceptT TCErr tcm (ProjOrigin, AmbiguousQName)
    -> ExceptT TCErr tcm (ProjOrigin, AmbiguousQName)
    forall a b. (a -> b) -> a -> b
    $ do
            Maybe Blocker
    block <- Arg Type -> ExceptT TCErr tcm (Maybe Blocker)
    forall t (m :: * -> *).
    (Reduce t, IsMeta t, MonadReduce m) =>
    t -> m (Maybe Blocker)
    isBlocked Arg Type
    target
            TypeError -> ExceptT TCErr tcm (ProjOrigin, AmbiguousQName)
    forall (m :: * -> *) a.
    (HasCallStack, ReadTCState m, MonadError TCErr m, MonadTCEnv m) =>
    TypeError -> m a
    softTypeError (TypeError -> ExceptT TCErr tcm (ProjOrigin, AmbiguousQName))
    -> TypeError -> ExceptT TCErr tcm (ProjOrigin, AmbiguousQName)
    forall a b. (a -> b) -> a -> b
    $ Maybe Blocker -> NamedArg Pattern -> Type -> TypeError
    CannotEliminateWithPattern Maybe Blocker
    block NamedArg Pattern
    p (Arg Type -> Type
    forall e. Arg e -> e
    unArg Arg Type
    target)

          (QName
    projName, Bool
    comatchingAllowed, QName
    recName, Arg Type
    projType, ArgInfo
    ai) <- TCM (QName, Bool, QName, Arg Type, ArgInfo)
    -> ExceptT TCErr tcm (QName, Bool, QName, Arg Type, ArgInfo)
    forall (m :: * -> *) a.
    (MonadTCM m, MonadError TCErr m) =>
    TCM a -> m a
    suspendErrors (TCM (QName, Bool, QName, Arg Type, ArgInfo)
     -> ExceptT TCErr tcm (QName, Bool, QName, Arg Type, ArgInfo))
    -> TCM (QName, Bool, QName, Arg Type, ArgInfo)
    -> ExceptT TCErr tcm (QName, Bool, QName, Arg Type, ArgInfo)
    forall a b. (a -> b) -> a -> b
    $ do
            -- Andreas, 2018-10-18, issue #3289: postfix projections do not have hiding
            -- information for their principal argument; we do not parse @{r}.p@ and the like.
            let h :: Maybe Hiding
    h = if ProjOrigin
    orig ProjOrigin -> ProjOrigin -> Bool
    forall a. Eq a => a -> a -> Bool
    == ProjOrigin
    ProjPostfix then Maybe Hiding
    forall a. Maybe a
    Nothing else Hiding -> Maybe Hiding
    forall a. a -> Maybe a
    Just (Hiding -> Maybe Hiding) -> Hiding -> Maybe Hiding
    forall a b. (a -> b) -> a -> b
    $ NamedArg Pattern -> Hiding
    forall a. LensHiding a => a -> Hiding
    getHiding NamedArg Pattern
    p
            Tele (Dom' Term Type)
    -> TCM (QName, Bool, QName, Arg Type, ArgInfo)
    -> TCM (QName, Bool, QName, Arg Type, ArgInfo)
    forall b (m :: * -> *) a.
    (AddContext b, MonadAddContext m) =>
    b -> m a -> m a
    addContext Tele (Dom' Term Type)
    tel (TCM (QName, Bool, QName, Arg Type, ArgInfo)
     -> TCM (QName, Bool, QName, Arg Type, ArgInfo))
    -> TCM (QName, Bool, QName, Arg Type, ArgInfo)
    -> TCM (QName, Bool, QName, Arg Type, ArgInfo)
    forall a b. (a -> b) -> a -> b
    $ Maybe Hiding
    -> AmbiguousQName
    -> Arg Type
    -> TCM (QName, Bool, QName, Arg Type, ArgInfo)
    disambiguateProjection Maybe Hiding
    h AmbiguousQName
    ambProjName Arg Type
    target

          Bool -> ExceptT TCErr tcm () -> ExceptT TCErr tcm ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless Bool
    comatchingAllowed (ExceptT TCErr tcm () -> ExceptT TCErr tcm ())
    -> ExceptT TCErr tcm () -> ExceptT TCErr tcm ()
    forall a b. (a -> b) -> a -> b
    $ do
            TypeError -> ExceptT TCErr tcm ()
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCM m) =>
    TypeError -> m a
    hardTypeError (TypeError -> ExceptT TCErr tcm ())
    -> (Doc -> TypeError) -> Doc -> ExceptT TCErr tcm ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Doc -> TypeError
    GenericDocError (Doc -> ExceptT TCErr tcm ())
    -> ExceptT TCErr tcm Doc -> ExceptT TCErr tcm ()
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< do
              TCMT IO Doc -> ExceptT TCErr tcm Doc
    forall (tcm :: * -> *) a. MonadTCM tcm => TCM a -> tcm a
    liftTCM (TCMT IO Doc -> ExceptT TCErr tcm Doc)
    -> TCMT IO Doc -> ExceptT TCErr tcm Doc
    forall a b. (a -> b) -> a -> b
    $ TCMT IO Doc
    "Copattern matching is disabled for record" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> QName -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM QName
    recName

          -- Compute the new rest type by applying the projection type to 'self'.
          -- Note: we cannot be in a let binding.
          QName
    f <- Maybe QName
    -> (QName -> ExceptT TCErr tcm QName)
    -> ExceptT TCErr tcm QName
    -> ExceptT TCErr tcm QName
    forall a b. Maybe a -> (a -> b) -> b -> b
    ifJust Maybe QName
    mf QName -> ExceptT TCErr tcm QName
    forall (m :: * -> *) a. Monad m => a -> m a
    return (ExceptT TCErr tcm QName -> ExceptT TCErr tcm QName)
    -> ExceptT TCErr tcm QName -> ExceptT TCErr tcm QName
    forall a b. (a -> b) -> a -> b
    $ TypeError -> ExceptT TCErr tcm QName
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCM m) =>
    TypeError -> m a
    hardTypeError (TypeError -> ExceptT TCErr tcm QName)
    -> TypeError -> ExceptT TCErr tcm QName
    forall a b. (a -> b) -> a -> b
    $
                 [Char] -> TypeError
    GenericError [Char]
    "Cannot use copatterns in a let binding"
          let self :: Term
    self = QName -> Elims -> Term
    Def QName
    f (Elims -> Term) -> Elims -> Term
    forall a b. (a -> b) -> a -> b
    $ [NamedArg DeBruijnPattern] -> Elims
    patternsToElims [NamedArg DeBruijnPattern]
    ip
          Arg Type
    target' <- (Type -> ExceptT TCErr tcm Type)
    -> Arg Type -> ExceptT TCErr tcm (Arg Type)
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    traverse (Type -> Term -> ExceptT TCErr tcm Type
    forall a (m :: * -> *).
    (PiApplyM a, MonadReduce m, HasBuiltins m) =>
    Type -> a -> m Type
    `piApplyM` Term
    self) Arg Type
    projType

          -- Compute the new state
          let projP :: NamedArg DeBruijnPattern
    projP    = Bool
    -> (NamedArg DeBruijnPattern -> NamedArg DeBruijnPattern)
    -> NamedArg DeBruijnPattern
    -> NamedArg DeBruijnPattern
    forall a. Bool -> (a -> a) -> a -> a
    applyWhen (ProjOrigin
    orig ProjOrigin -> ProjOrigin -> Bool
    forall a. Eq a => a -> a -> Bool
    == ProjOrigin
    ProjPostfix) (Hiding -> NamedArg DeBruijnPattern -> NamedArg DeBruijnPattern
    forall a. LensHiding a => Hiding -> a -> a
    setHiding Hiding
    NotHidden) (NamedArg DeBruijnPattern -> NamedArg DeBruijnPattern)
    -> NamedArg DeBruijnPattern -> NamedArg DeBruijnPattern
    forall a b. (a -> b) -> a -> b
    $
                           ArgInfo
    -> Named NamedName DeBruijnPattern -> NamedArg DeBruijnPattern
    forall e. ArgInfo -> e -> Arg e
    Arg ArgInfo
    ai (Named NamedName DeBruijnPattern -> NamedArg DeBruijnPattern)
    -> Named NamedName DeBruijnPattern -> NamedArg DeBruijnPattern
    forall a b. (a -> b) -> a -> b
    $ Maybe NamedName
    -> DeBruijnPattern -> Named NamedName DeBruijnPattern
    forall name a. Maybe name -> a -> Named name a
    Named Maybe NamedName
    forall a. Maybe a
    Nothing (ProjOrigin -> QName -> DeBruijnPattern
    forall x. ProjOrigin -> QName -> Pattern' x
    ProjP ProjOrigin
    orig QName
    projName)
              ip' :: [NamedArg DeBruijnPattern]
    ip'      = [NamedArg DeBruijnPattern]
    ip [NamedArg DeBruijnPattern]
    -> [NamedArg DeBruijnPattern] -> [NamedArg DeBruijnPattern]
    forall a. [a] -> [a] -> [a]
    ++ [NamedArg DeBruijnPattern
    projP]
              -- drop the projection pattern (already splitted)
              problem' :: Problem a
    problem' = Lens' [NamedArg Pattern] (Problem a)
    -> LensMap [NamedArg Pattern] (Problem a)
    forall i o. Lens' i o -> LensMap i o
    over forall a. Lens' [NamedArg Pattern] (Problem a)
    Lens' [NamedArg Pattern] (Problem a)
    problemRestPats [NamedArg Pattern] -> [NamedArg Pattern]
    forall a. [a] -> [a]
    tail Problem a
    problem
          TCM (LHSState a) -> ExceptT TCErr tcm (LHSState a)
    forall (tcm :: * -> *) a. MonadTCM tcm => TCM a -> tcm a
    liftTCM (TCM (LHSState a) -> ExceptT TCErr tcm (LHSState a))
    -> TCM (LHSState a) -> ExceptT TCErr tcm (LHSState a)
    forall a b. (a -> b) -> a -> b
    $ LHSState a -> TCM (LHSState a)
    forall a. LHSState a -> TCM (LHSState a)
    updateLHSState (Tele (Dom' Term Type)
    -> [NamedArg DeBruijnPattern]
    -> Problem a
    -> Arg Type
    -> [Maybe Int]
    -> LHSState a
    forall a.
    Tele (Dom' Term Type)
    -> [NamedArg DeBruijnPattern]
    -> Problem a
    -> Arg Type
    -> [Maybe Int]
    -> LHSState a
    LHSState Tele (Dom' Term Type)
    tel [NamedArg DeBruijnPattern]
    ip' Problem a
    problem' Arg Type
    target' [Maybe Int]
    psplit)

        -- Split a Partial.
        --
        -- Example for splitPartial:
        -- @
        --   g : ∀ i j → Partial (i ∨ j) A
        --   g i j (i = 1) = a i j
        --   g i j (j = 1) = b i j
        -- @
        -- leads to, in the first clause:
        -- @
        --   dom   = IsOne (i ∨ j)
        --   ts    = [(i, 1)]
        --   phi   = i
        --   sigma = [1/i]
        -- @
        -- Final clauses:
        -- @
        --   g : ∀ i j → Partial (i ∨ j) A
        --   g 1? j  .itIsOne = a 1 j
        --   g i  1? .itIsOne = b i 1
        -- @
        -- Herein, ? indicates a 'conPFallThrough' pattern.
        --
        -- Example for splitPartial:
        -- @
        --   h : ∀ i j → Partial (i & ¬ j) A
        --   h i j (i = 1) (j = 0)
        --   -- ALT: h i j (i & ¬ j = 1)
        -- @
        -- gives
        -- @
        --   dom = IsOne (i & ¬ j)
        --   ts  = [(i,1), (j,0)]  -- ALT: [(i & ¬ j, 1)]
        --   phi = i & ¬ j
        --   sigma = [1/i,0/j]
        -- @
        --
        -- Example for splitPartial:
        -- @
        --   g : ∀ i j → Partial (i ∨ j) A
        --   g i j (i ∨ j = 1) = a i j
        -- @
        -- leads to, in the first clause:
        -- @
        --   dom   = IsOne (i ∨ j)
        --   ts    = [(i ∨ j, 1)]
        --   phi   = i ∨ j
        --   sigma = fails because several substitutions [[1/i],[1/j]] correspond to phi
        -- @

        splitPartial :: Telescope     -- The types of arguments before the one we split on
                     -> Dom Type      -- The type of the argument we split on
                     -> Abs Telescope -- The types of arguments after the one we split on
                     -> [(A.Expr, A.Expr)] -- [(φ₁ = b1),..,(φn = bn)]
                     -> ExceptT TCErr tcm (LHSState a)
        splitPartial :: Tele (Dom' Term Type)
    -> Dom' Term Type
    -> Abs (Tele (Dom' Term Type))
    -> [(Expr, Expr)]
    -> ExceptT TCErr tcm (LHSState a)
    splitPartial Tele (Dom' Term Type)
    delta1 Dom' Term Type
    dom Abs (Tele (Dom' Term Type))
    adelta2 [(Expr, Expr)]
    ts = do

          Bool -> ExceptT TCErr tcm () -> ExceptT TCErr tcm ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless (Dom' Term Type -> Bool
    forall t e. Dom' t e -> Bool
    domFinite Dom' Term Type
    dom) (ExceptT TCErr tcm () -> ExceptT TCErr tcm ())
    -> ExceptT TCErr tcm () -> ExceptT TCErr tcm ()
    forall a b. (a -> b) -> a -> b
    $ TCMT IO () -> ExceptT TCErr tcm ()
    forall (tcm :: * -> *) a. MonadTCM tcm => TCM a -> tcm a
    liftTCM (TCMT IO () -> ExceptT TCErr tcm ())
    -> TCMT IO () -> ExceptT TCErr tcm ()
    forall a b. (a -> b) -> a -> b
    $ Tele (Dom' Term Type) -> TCMT IO () -> TCMT IO ()
    forall b (m :: * -> *) a.
    (AddContext b, MonadAddContext m) =>
    b -> m a -> m a
    addContext Tele (Dom' Term Type)
    delta1 (TCMT IO () -> TCMT IO ()) -> TCMT IO () -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $
            TypeError -> TCMT IO ()
    forall (m :: * -> *) a.
    (HasCallStack, ReadTCState m, MonadError TCErr m, MonadTCEnv m) =>
    TypeError -> m a
    softTypeError (TypeError -> TCMT IO ())
    -> (Doc -> TypeError) -> Doc -> TCMT IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Doc -> TypeError
    GenericDocError (Doc -> TCMT IO ()) -> TCMT IO Doc -> TCMT IO ()
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<<
            [TCMT IO Doc] -> TCMT IO Doc
    forall (m :: * -> *) (t :: * -> *).
    (Applicative m, Foldable t) =>
    t (m Doc) -> m Doc
    hsep [ TCMT IO Doc
    "Not a finite domain:" , Type -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM (Type -> TCMT IO Doc) -> Type -> TCMT IO Doc
    forall a b. (a -> b) -> a -> b
    $ Dom' Term Type -> Type
    forall t e. Dom' t e -> e
    unDom Dom' Term Type
    dom ]

          Type
    tInterval <- TCMT IO Type -> ExceptT TCErr tcm Type
    forall (tcm :: * -> *) a. MonadTCM tcm => TCM a -> tcm a
    liftTCM (TCMT IO Type -> ExceptT TCErr tcm Type)
    -> TCMT IO Type -> ExceptT TCErr tcm Type
    forall a b. (a -> b) -> a -> b
    $ TCMT IO Type
    forall (m :: * -> *).
    (HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
    m Type
    primIntervalType

          [Maybe Name]
    names <- TCM [Maybe Name] -> ExceptT TCErr tcm [Maybe Name]
    forall (tcm :: * -> *) a. MonadTCM tcm => TCM a -> tcm a
    liftTCM (TCM [Maybe Name] -> ExceptT TCErr tcm [Maybe Name])
    -> TCM [Maybe Name] -> ExceptT TCErr tcm [Maybe Name]
    forall a b. (a -> b) -> a -> b
    $ Tele (Dom' Term Type) -> TCM [Maybe Name] -> TCM [Maybe Name]
    forall b (m :: * -> *) a.
    (AddContext b, MonadAddContext m) =>
    b -> m a -> m a
    addContext Tele (Dom' Term Type)
    tel (TCM [Maybe Name] -> TCM [Maybe Name])
    -> TCM [Maybe Name] -> TCM [Maybe Name]
    forall a b. (a -> b) -> a -> b
    $ do
            LeftoverPatterns{patternVariables :: LeftoverPatterns -> IntMap [(Name, PatVarPosition)]
    patternVariables = IntMap [(Name, PatVarPosition)]
    vars} <- [ProblemEq] -> TCMT IO LeftoverPatterns
    forall (m :: * -> *).
    PureTCM m =>
    [ProblemEq] -> m LeftoverPatterns
    getLeftoverPatterns ([ProblemEq] -> TCMT IO LeftoverPatterns)
    -> [ProblemEq] -> TCMT IO LeftoverPatterns
    forall a b. (a -> b) -> a -> b
    $ Problem a
    problem Problem a -> Lens' [ProblemEq] (Problem a) -> [ProblemEq]
    forall o i. o -> Lens' i o -> i
    ^. forall a. Lens' [ProblemEq] (Problem a)
    Lens' [ProblemEq] (Problem a)
    problemEqs
            [Maybe Name] -> TCM [Maybe Name]
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([Maybe Name] -> TCM [Maybe Name])
    -> [Maybe Name] -> TCM [Maybe Name]
    forall a b. (a -> b) -> a -> b
    $ Int -> [Maybe Name] -> [Maybe Name]
    forall a. Int -> [a] -> [a]
    take (Tele (Dom' Term Type) -> Int
    forall a. Sized a => a -> Int
    size Tele (Dom' Term Type)
    delta1) ([Maybe Name] -> [Maybe Name]) -> [Maybe Name] -> [Maybe Name]
    forall a b. (a -> b) -> a -> b
    $ ([Maybe Name], [AsBinding]) -> [Maybe Name]
    forall a b. (a, b) -> a
    fst (([Maybe Name], [AsBinding]) -> [Maybe Name])
    -> ([Maybe Name], [AsBinding]) -> [Maybe Name]
    forall a b. (a -> b) -> a -> b
    $ Tele (Dom' Term Type)
    -> IntMap [(Name, PatVarPosition)] -> ([Maybe Name], [AsBinding])
    getUserVariableNames Tele (Dom' Term Type)
    tel IntMap [(Name, PatVarPosition)]
    vars

          -- Problem: The context does not match the checkpoints in checkLHS,
          --          however we still need a proper checkpoint substitution
          --          for checkExpr below.
          --
          -- Solution: partial splits are not allowed when there are
          --           constructor patterns (checked in checkDef), so
          --           newContext is an extension of the definition
          --           context.
          --
          -- i.e.: Given
          --
          --             Γ = context where def is checked, also last checkpoint.
          --
          --       Then
          --
          --             newContext = Γ Ξ
          --             cpSub = raiseS |Ξ|
          --
          Int
    lhsCxtSize <- ExceptT TCErr tcm Int
    forall r (m :: * -> *). MonadReader r m => m r
    ask -- size of the context before checkLHS call.
          [Char] -> Int -> TCMT IO Doc -> ExceptT TCErr tcm ()
    forall (m :: * -> *).
    MonadDebug m =>
    [Char] -> Int -> TCMT IO Doc -> m ()
    reportSDoc [Char]
    "tc.lhs.split.partial" Int
    10 (TCMT IO Doc -> ExceptT TCErr tcm ())
    -> TCMT IO Doc -> ExceptT TCErr tcm ()
    forall a b. (a -> b) -> a -> b
    $ TCMT IO Doc
    "lhsCxtSize =" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> Int -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM Int
    lhsCxtSize

          Context
    newContext <- TCM Context -> ExceptT TCErr tcm Context
    forall (tcm :: * -> *) a. MonadTCM tcm => TCM a -> tcm a
    liftTCM (TCM Context -> ExceptT TCErr tcm Context)
    -> TCM Context -> ExceptT TCErr tcm Context
    forall a b. (a -> b) -> a -> b
    $ [Maybe Name] -> Tele (Dom' Term Type) -> TCM Context
    computeLHSContext [Maybe Name]
    names Tele (Dom' Term Type)
    delta1
          [Char] -> Int -> TCMT IO Doc -> ExceptT TCErr tcm ()
    forall (m :: * -> *).
    MonadDebug m =>
    [Char] -> Int -> TCMT IO Doc -> m ()
    reportSDoc [Char]
    "tc.lhs.split.partial" Int
    10 (TCMT IO Doc -> ExceptT TCErr tcm ())
    -> TCMT IO Doc -> ExceptT TCErr tcm ()
    forall a b. (a -> b) -> a -> b
    $ TCMT IO Doc
    "newContext =" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> Context -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM Context
    newContext

          let cpSub :: Substitution
    cpSub = Int -> Substitution
    forall a. Int -> Substitution' a
    raiseS (Int -> Substitution) -> Int -> Substitution
    forall a b. (a -> b) -> a -> b
    $ Context -> Int
    forall a. Sized a => a -> Int
    size Context
    newContext Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    lhsCxtSize

          (Tele (Dom' Term Type)
    gamma,Substitution
    sigma) <- TCM (Tele (Dom' Term Type), Substitution)
    -> ExceptT TCErr tcm (Tele (Dom' Term Type), Substitution)
    forall (tcm :: * -> *) a. MonadTCM tcm => TCM a -> tcm a
    liftTCM (TCM (Tele (Dom' Term Type), Substitution)
     -> ExceptT TCErr tcm (Tele (Dom' Term Type), Substitution))
    -> TCM (Tele (Dom' Term Type), Substitution)
    -> ExceptT TCErr tcm (Tele (Dom' Term Type), Substitution)
    forall a b. (a -> b) -> a -> b
    $ Substitution
    -> (Context -> Context)
    -> TCM (Tele (Dom' Term Type), Substitution)
    -> TCM (Tele (Dom' Term Type), Substitution)
    forall (m :: * -> *) a.
    MonadAddContext m =>
    Substitution -> (Context -> Context) -> m a -> m a
    updateContext Substitution
    cpSub (Context -> Context -> Context
    forall a b. a -> b -> a
    const Context
    newContext) (TCM (Tele (Dom' Term Type), Substitution)
     -> TCM (Tele (Dom' Term Type), Substitution))
    -> TCM (Tele (Dom' Term Type), Substitution)
    -> TCM (Tele (Dom' Term Type), Substitution)
    forall a b. (a -> b) -> a -> b
    $ do
             [Term]
    ts <- [(Expr, Expr)] -> ((Expr, Expr) -> TCMT IO Term) -> TCMT IO [Term]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    t a -> (a -> m b) -> m (t b)
    forM [(Expr, Expr)]
    ts (((Expr, Expr) -> TCMT IO Term) -> TCMT IO [Term])
    -> ((Expr, Expr) -> TCMT IO Term) -> TCMT IO [Term]
    forall a b. (a -> b) -> a -> b
    $ \ (Expr
    t,Expr
    u) -> do
                     [Char] -> Int -> TCMT IO Doc -> TCMT IO ()
    forall (m :: * -> *).
    MonadDebug m =>
    [Char] -> Int -> TCMT IO Doc -> m ()
    reportSDoc [Char]
    "tc.lhs.split.partial" Int
    10 (TCMT IO Doc -> TCMT IO ()) -> TCMT IO Doc -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ TCMT IO Doc
    "currentCxt =" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> (Context -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM (Context -> TCMT IO Doc) -> TCM Context -> TCMT IO Doc
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< TCM Context
    forall (m :: * -> *). MonadTCEnv m => m Context
    getContext)
                     [Char] -> Int -> TCMT IO Doc -> TCMT IO ()
    forall (m :: * -> *).
    MonadDebug m =>
    [Char] -> Int -> TCMT IO Doc -> m ()
    reportSDoc [Char]
    "tc.lhs.split.partial" Int
    10 (TCMT IO Doc -> TCMT IO ()) -> TCMT IO Doc -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ [Char] -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => [Char] -> m Doc
    text [Char]
    "t, u (Expr) =" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> (Expr, Expr) -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM (Expr
    t,Expr
    u)
                     Term
    t <- Expr -> Type -> TCMT IO Term
    checkExpr Expr
    t Type
    tInterval
                     Term
    u <- Expr -> Type -> TCMT IO Term
    checkExpr Expr
    u Type
    tInterval
                     [Char] -> Int -> TCMT IO Doc -> TCMT IO ()
    forall (m :: * -> *).
    MonadDebug m =>
    [Char] -> Int -> TCMT IO Doc -> m ()
    reportSDoc [Char]
    "tc.lhs.split.partial" Int
    10 (TCMT IO Doc -> TCMT IO ()) -> TCMT IO Doc -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ [Char] -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => [Char] -> m Doc
    text [Char]
    "t, u        =" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> (Term, Term) -> TCMT IO Doc
    forall (m :: * -> *) a. (Applicative m, Pretty a) => a -> m Doc
    pretty (Term
    t, Term
    u)
                     IntervalView
    u <- Term -> TCMT IO IntervalView
    forall (m :: * -> *). HasBuiltins m => Term -> m IntervalView
    intervalView (Term -> TCMT IO IntervalView)
    -> TCMT IO Term -> TCMT IO IntervalView
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< Term -> TCMT IO Term
    forall a (m :: * -> *). (Reduce a, MonadReduce m) => a -> m a
    reduce Term
    u
                     case IntervalView
    u of
                       IntervalView
    IZero -> TCMT IO Term
    forall (m :: * -> *).
    (HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
    m Term
    primINeg TCMT IO Term -> TCMT IO Term -> TCMT IO Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <@> Term -> TCMT IO Term
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Term
    t
                       IntervalView
    IOne  -> Term -> TCMT IO Term
    forall (m :: * -> *) a. Monad m => a -> m a
    return Term
    t
                       IntervalView
    _     -> TypeError -> TCMT IO Term
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCError m) =>
    TypeError -> m a
    typeError (TypeError -> TCMT IO Term) -> TypeError -> TCMT IO Term
    forall a b. (a -> b) -> a -> b
    $ [Char] -> TypeError
    GenericError ([Char] -> TypeError) -> [Char] -> TypeError
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "Only 0 or 1 allowed on the rhs of face"
             -- Example: ts = (i=0) (j=1) will result in phi = ¬ i & j
             Term
    phi <- case [Term]
    ts of
                       [] -> do
                         Term
    a <- Term -> TCMT IO Term
    forall a (m :: * -> *). (Reduce a, MonadReduce m) => a -> m a
    reduce (Type -> Term
    forall t a. Type'' t a -> a
    unEl (Type -> Term) -> Type -> Term
    forall a b. (a -> b) -> a -> b
    $ Dom' Term Type -> Type
    forall t e. Dom' t e -> e
    unDom Dom' Term Type
    dom)
                         -- builtinIsOne is defined, since this is a precondition for having Partial
                         QName
    isone <- QName -> Maybe QName -> QName
    forall a. a -> Maybe a -> a
    fromMaybe QName
    forall a. HasCallStack => a
    __IMPOSSIBLE__ (Maybe QName -> QName) -> TCMT IO (Maybe QName) -> TCMT IO QName
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$>  -- newline because of CPP
                           [Char] -> TCMT IO (Maybe QName)
    forall (m :: * -> *). HasBuiltins m => [Char] -> m (Maybe QName)
    getBuiltinName' [Char]
    builtinIsOne
                         case Term
    a of
                           Def QName
    q [Apply Arg Term
    phi] | QName
    q QName -> QName -> Bool
    forall a. Eq a => a -> a -> Bool
    == QName
    isone -> Term -> TCMT IO Term
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Arg Term -> Term
    forall e. Arg e -> e
    unArg Arg Term
    phi)
                           Term
    _           -> TypeError -> TCMT IO Term
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCError m) =>
    TypeError -> m a
    typeError (TypeError -> TCMT IO Term)
    -> (Doc -> TypeError) -> Doc -> TCMT IO Term
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Doc -> TypeError
    GenericDocError (Doc -> TCMT IO Term) -> TCMT IO Doc -> TCMT IO Term
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< do
                             Term -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM Term
    a TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> TCMT IO Doc
    " is not IsOne."

                       [Term]
    _  -> (TCMT IO Term -> TCMT IO Term -> TCMT IO Term)
    -> TCMT IO Term -> [TCMT IO Term] -> TCMT IO Term
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl (\ TCMT IO Term
    x TCMT IO Term
    y -> TCMT IO Term
    forall (m :: * -> *).
    (HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
    m Term
    primIMin TCMT IO Term -> TCMT IO Term -> TCMT IO Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <@> TCMT IO Term
    x TCMT IO Term -> TCMT IO Term -> TCMT IO Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <@> TCMT IO Term
    y) TCMT IO Term
    forall (m :: * -> *).
    (HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
    m Term
    primIOne ((Term -> TCMT IO Term) -> [Term] -> [TCMT IO Term]
    forall a b. (a -> b) -> [a] -> [b]
    map Term -> TCMT IO Term
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure [Term]
    ts)
             [Char] -> Int -> TCMT IO Doc -> TCMT IO ()
    forall (m :: * -> *).
    MonadDebug m =>
    [Char] -> Int -> TCMT IO Doc -> m ()
    reportSDoc [Char]
    "tc.lhs.split.partial" Int
    10 (TCMT IO Doc -> TCMT IO ()) -> TCMT IO Doc -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ [Char] -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => [Char] -> m Doc
    text [Char]
    "phi           =" 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
    phi
             [Char] -> Int -> TCMT IO Doc -> TCMT IO ()
    forall (m :: * -> *).
    MonadDebug m =>
    [Char] -> Int -> TCMT IO Doc -> m ()
    reportSDoc [Char]
    "tc.lhs.split.partial" Int
    30 (TCMT IO Doc -> TCMT IO ()) -> TCMT IO Doc -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ [Char] -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => [Char] -> m Doc
    text [Char]
    "phi           =" 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
             Term
    phi <- Term -> TCMT IO Term
    forall a (m :: * -> *). (Reduce a, MonadReduce m) => a -> m a
    reduce Term
    phi
             [Char] -> Int -> TCMT IO Doc -> TCMT IO ()
    forall (m :: * -> *).
    MonadDebug m =>
    [Char] -> Int -> TCMT IO Doc -> m ()
    reportSDoc [Char]
    "tc.lhs.split.partial" Int
    10 (TCMT IO Doc -> TCMT IO ()) -> TCMT IO Doc -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ [Char] -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => [Char] -> m Doc
    text [Char]
    "phi (reduced) =" 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
    phi
             [(Tele (Dom' Term Type), Substitution)]
    refined <- Term
    -> (Map Int Bool
        -> Blocker -> Term -> TCM (Tele (Dom' Term Type), Substitution))
    -> (Substitution -> TCM (Tele (Dom' Term Type), Substitution))
    -> TCMT IO [(Tele (Dom' Term Type), Substitution)]
    forall (m :: * -> *) a.
    MonadConversion m =>
    Term
    -> (Map Int Bool -> Blocker -> Term -> m a)
    -> (Substitution -> m a)
    -> m [a]
    forallFaceMaps Term
    phi (\ Map Int Bool
    bs Blocker
    m Term
    t -> TypeError -> TCM (Tele (Dom' Term Type), Substitution)
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCError m) =>
    TypeError -> m a
    typeError (TypeError -> TCM (Tele (Dom' Term Type), Substitution))
    -> TypeError -> TCM (Tele (Dom' Term Type), Substitution)
    forall a b. (a -> b) -> a -> b
    $ [Char] -> TypeError
    GenericError ([Char] -> TypeError) -> [Char] -> TypeError
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "face blocked on meta")
                                (\ Substitution
    sigma -> (,Substitution
    sigma) (Tele (Dom' Term Type) -> (Tele (Dom' Term Type), Substitution))
    -> TCMT IO (Tele (Dom' Term Type))
    -> TCM (Tele (Dom' Term Type), Substitution)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> TCMT IO (Tele (Dom' Term Type))
    forall (m :: * -> *).
    (Applicative m, MonadTCEnv m) =>
    m (Tele (Dom' Term Type))
    getContextTelescope)
             case [(Tele (Dom' Term Type), Substitution)]
    refined of
               [(Tele (Dom' Term Type)
    gamma,Substitution
    sigma)] -> (Tele (Dom' Term Type), Substitution)
    -> TCM (Tele (Dom' Term Type), Substitution)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Tele (Dom' Term Type)
    gamma,Substitution
    sigma)
               []              -> TypeError -> TCM (Tele (Dom' Term Type), Substitution)
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCError m) =>
    TypeError -> m a
    typeError (TypeError -> TCM (Tele (Dom' Term Type), Substitution))
    -> TypeError -> TCM (Tele (Dom' Term Type), Substitution)
    forall a b. (a -> b) -> a -> b
    $ [Char] -> TypeError
    GenericError ([Char] -> TypeError) -> [Char] -> TypeError
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "The face constraint is unsatisfiable."
               [(Tele (Dom' Term Type), Substitution)]
    _               -> TypeError -> TCM (Tele (Dom' Term Type), Substitution)
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCError m) =>
    TypeError -> m a
    typeError (TypeError -> TCM (Tele (Dom' Term Type), Substitution))
    -> TypeError -> TCM (Tele (Dom' Term Type), Substitution)
    forall a b. (a -> b) -> a -> b
    $ [Char] -> TypeError
    GenericError ([Char] -> TypeError) -> [Char] -> TypeError
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "Cannot have disjunctions in a face constraint."
          Term
    itisone <- TCMT IO Term -> ExceptT TCErr tcm Term
    forall (tcm :: * -> *) a. MonadTCM tcm => TCM a -> tcm a
    liftTCM TCMT IO Term
    forall (m :: * -> *).
    (HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
    m Term
    primItIsOne
          -- substitute the literal in p1 and dpi
          [Char] -> Int -> TCMT IO Doc -> ExceptT TCErr tcm ()
    forall (m :: * -> *).
    MonadDebug m =>
    [Char] -> Int -> TCMT IO Doc -> m ()
    reportSDoc [Char]
    "tc.lhs.faces" Int
    60 (TCMT IO Doc -> ExceptT TCErr tcm ())
    -> TCMT IO Doc -> ExceptT TCErr tcm ()
    forall a b. (a -> b) -> a -> b
    $ [Char] -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => [Char] -> m Doc
    text ([Char] -> TCMT IO Doc) -> [Char] -> TCMT IO Doc
    forall a b. (a -> b) -> a -> b
    $ Substitution -> [Char]
    forall a. Show a => a -> [Char]
    show Substitution
    sigma

          let oix :: Int
    oix = Abs (Tele (Dom' Term Type)) -> Int
    forall a. Sized a => a -> Int
    size Abs (Tele (Dom' Term Type))
    adelta2 -- de brujin index of IsOne
              o_n :: Int
    o_n = Int -> Maybe Int -> Int
    forall a. a -> Maybe a -> a
    fromMaybe Int
    forall a. HasCallStack => a
    __IMPOSSIBLE__ (Maybe Int -> Int) -> Maybe Int -> Int
    forall a b. (a -> b) -> a -> b
    $
                (NamedArg DeBruijnPattern -> Bool)
    -> [NamedArg DeBruijnPattern] -> Maybe Int
    forall a. (a -> Bool) -> [a] -> Maybe Int
    findIndex (\ NamedArg DeBruijnPattern
    x -> case Named NamedName DeBruijnPattern -> DeBruijnPattern
    forall name a. Named name a -> a
    namedThing (NamedArg DeBruijnPattern -> Named NamedName DeBruijnPattern
    forall e. Arg e -> e
    unArg NamedArg DeBruijnPattern
    x) of
                                       VarP PatternInfo
    _ DBPatVar
    x -> DBPatVar -> Int
    dbPatVarIndex DBPatVar
    x Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    oix
                                       DeBruijnPattern
    _        -> Bool
    False) [NamedArg DeBruijnPattern]
    ip
              delta2' :: Tele (Dom' Term Type)
    delta2' = Abs (Tele (Dom' Term Type))
    -> SubstArg (Tele (Dom' Term Type)) -> Tele (Dom' Term Type)
    forall a. Subst a => Abs a -> SubstArg a -> a
    absApp Abs (Tele (Dom' Term Type))
    adelta2 Term
    SubstArg (Tele (Dom' Term Type))
    itisone
              delta2 :: Tele (Dom' Term Type)
    delta2 = Substitution' (SubstArg (Tele (Dom' Term Type)))
    -> Tele (Dom' Term Type) -> Tele (Dom' Term Type)
    forall a. Subst a => Substitution' (SubstArg a) -> a -> a
    applySubst Substitution
    Substitution' (SubstArg (Tele (Dom' Term Type)))
    sigma Tele (Dom' Term Type)
    delta2'
              mkConP :: Term -> DeBruijnPattern
    mkConP (Con ConHead
    c ConInfo
    _ [])
                 = ConHead
    -> ConPatternInfo -> [NamedArg DeBruijnPattern] -> DeBruijnPattern
    forall x.
    ConHead -> ConPatternInfo -> [NamedArg (Pattern' x)] -> Pattern' x
    ConP ConHead
    c (ConPatternInfo
    noConPatternInfo { conPType :: Maybe (Arg Type)
    conPType = Arg Type -> Maybe (Arg Type)
    forall a. a -> Maybe a
    Just (ArgInfo -> Type -> Arg Type
    forall e. ArgInfo -> e -> Arg e
    Arg ArgInfo
    defaultArgInfo Type
    tInterval)
                                                  , conPFallThrough :: Bool
    conPFallThrough = Bool
    True })
                              []
              mkConP (Var Int
    i []) = PatternInfo -> DBPatVar -> DeBruijnPattern
    forall x. PatternInfo -> x -> Pattern' x
    VarP PatternInfo
    defaultPatternInfo ([Char] -> Int -> DBPatVar
    DBPatVar [Char]
    "x" Int
    i)
              mkConP Term
    _          = DeBruijnPattern
    forall a. HasCallStack => a
    __IMPOSSIBLE__
              rho0 :: Substitution' DeBruijnPattern
    rho0 = (Term -> DeBruijnPattern)
    -> Substitution -> Substitution' DeBruijnPattern
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Term -> DeBruijnPattern
    mkConP Substitution
    sigma

              rho :: Substitution' DeBruijnPattern
    rho    = Int
    -> Substitution' DeBruijnPattern -> Substitution' DeBruijnPattern
    forall a. Int -> Substitution' a -> Substitution' a
    liftS (Tele (Dom' Term Type) -> Int
    forall a. Sized a => a -> Int
    size Tele (Dom' Term Type)
    delta2) (Substitution' DeBruijnPattern -> Substitution' DeBruijnPattern)
    -> Substitution' DeBruijnPattern -> Substitution' DeBruijnPattern
    forall a b. (a -> b) -> a -> b
    $ DeBruijnPattern
    -> Substitution' DeBruijnPattern -> Substitution' DeBruijnPattern
    forall a. DeBruijn a => a -> Substitution' a -> Substitution' a
    consS (PatternInfo -> Term -> DeBruijnPattern
    forall x. PatternInfo -> Term -> Pattern' x
    DotP PatternInfo
    defaultPatternInfo Term
    itisone) Substitution' DeBruijnPattern
    rho0

              delta' :: Tele (Dom' Term Type)
    delta'   = Tele (Dom' Term Type)
    -> Tele (Dom' Term Type) -> Tele (Dom' Term Type)
    forall t. Abstract t => Tele (Dom' Term Type) -> t -> t
    abstract Tele (Dom' Term Type)
    gamma Tele (Dom' Term Type)
    delta2
              eqs' :: [ProblemEq]
    eqs'     = Substitution' DeBruijnPattern -> [ProblemEq] -> [ProblemEq]
    forall a. TermSubst a => Substitution' DeBruijnPattern -> a -> a
    applyPatSubst Substitution' DeBruijnPattern
    rho ([ProblemEq] -> [ProblemEq]) -> [ProblemEq] -> [ProblemEq]
    forall a b. (a -> b) -> a -> b
    $ Problem a
    problem Problem a -> Lens' [ProblemEq] (Problem a) -> [ProblemEq]
    forall o i. o -> Lens' i o -> i
    ^. forall a. Lens' [ProblemEq] (Problem a)
    Lens' [ProblemEq] (Problem a)
    problemEqs
              ip' :: [NamedArg DeBruijnPattern]
    ip'      = Substitution' (SubstArg [NamedArg DeBruijnPattern])
    -> [NamedArg DeBruijnPattern] -> [NamedArg DeBruijnPattern]
    forall a. Subst a => Substitution' (SubstArg a) -> a -> a
    applySubst Substitution' DeBruijnPattern
    Substitution' (SubstArg [NamedArg DeBruijnPattern])
    rho [NamedArg DeBruijnPattern]
    ip
              target' :: Arg Type
    target'  = Substitution' DeBruijnPattern -> Arg Type -> Arg Type
    forall a. TermSubst a => Substitution' DeBruijnPattern -> a -> a
    applyPatSubst Substitution' DeBruijnPattern
    rho Arg Type
    target

          -- Compute the new state
          let problem' :: Problem a
    problem' = Lens' [ProblemEq] (Problem a) -> LensSet [ProblemEq] (Problem a)
    forall i o. Lens' i o -> LensSet i o
    set forall a. Lens' [ProblemEq] (Problem a)
    Lens' [ProblemEq] (Problem a)
    problemEqs [ProblemEq]
    eqs' Problem a
    problem
          [Char] -> Int -> TCMT IO Doc -> ExceptT TCErr tcm ()
    forall (m :: * -> *).
    MonadDebug m =>
    [Char] -> Int -> TCMT IO Doc -> m ()
    reportSDoc [Char]
    "tc.lhs.split.partial" Int
    60 (TCMT IO Doc -> ExceptT TCErr tcm ())
    -> TCMT IO Doc -> ExceptT TCErr tcm ()
    forall a b. (a -> b) -> a -> b
    $ [Char] -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => [Char] -> m Doc
    text (Problem a -> [Char]
    forall a. Show a => a -> [Char]
    show Problem a
    problem')
          TCM (LHSState a) -> ExceptT TCErr tcm (LHSState a)
    forall (tcm :: * -> *) a. MonadTCM tcm => TCM a -> tcm a
    liftTCM (TCM (LHSState a) -> ExceptT TCErr tcm (LHSState a))
    -> TCM (LHSState a) -> ExceptT TCErr tcm (LHSState a)
    forall a b. (a -> b) -> a -> b
    $ LHSState a -> TCM (LHSState a)
    forall a. LHSState a -> TCM (LHSState a)
    updateLHSState (Tele (Dom' Term Type)
    -> [NamedArg DeBruijnPattern]
    -> Problem a
    -> Arg Type
    -> [Maybe Int]
    -> LHSState a
    forall a.
    Tele (Dom' Term Type)
    -> [NamedArg DeBruijnPattern]
    -> Problem a
    -> Arg Type
    -> [Maybe Int]
    -> LHSState a
    LHSState Tele (Dom' Term Type)
    delta' [NamedArg DeBruijnPattern]
    ip' Problem a
    problem' Arg Type
    target' ([Maybe Int]
    psplit [Maybe Int] -> [Maybe Int] -> [Maybe Int]
    forall a. [a] -> [a] -> [a]
    ++ [Int -> Maybe Int
    forall a. a -> Maybe a
    Just Int
    o_n]))

        splitLit :: Telescope      -- The types of arguments before the one we split on
                 -> Dom Type       -- The type of the literal we split on
                 -> Abs Telescope  -- The types of arguments after the one we split on
                 -> Literal        -- The literal written by the user
                 -> ExceptT TCErr tcm (LHSState a)
        splitLit :: Tele (Dom' Term Type)
    -> Dom' Term Type
    -> Abs (Tele (Dom' Term Type))
    -> Literal
    -> ExceptT TCErr tcm (LHSState a)
    splitLit Tele (Dom' Term Type)
    delta1 dom :: Dom' Term Type
    dom@Dom{domInfo :: forall t e. Dom' t e -> ArgInfo
    domInfo = ArgInfo
    info, unDom :: forall t e. Dom' t e -> e
    unDom = Type
    a} Abs (Tele (Dom' Term Type))
    adelta2 Literal
    lit = do
          let delta2 :: Tele (Dom' Term Type)
    delta2 = Abs (Tele (Dom' Term Type))
    -> SubstArg (Tele (Dom' Term Type)) -> Tele (Dom' Term Type)
    forall a. Subst a => Abs a -> SubstArg a -> a
    absApp Abs (Tele (Dom' Term Type))
    adelta2 (Literal -> Term
    Lit Literal
    lit)
              delta' :: Tele (Dom' Term Type)
    delta' = Tele (Dom' Term Type)
    -> Tele (Dom' Term Type) -> Tele (Dom' Term Type)
    forall t. Abstract t => Tele (Dom' Term Type) -> t -> t
    abstract Tele (Dom' Term Type)
    delta1 Tele (Dom' Term Type)
    delta2
              rho :: Substitution' DeBruijnPattern
    rho    = Int -> DeBruijnPattern -> Substitution' DeBruijnPattern
    forall a. DeBruijn a => Int -> a -> Substitution' a
    singletonS (Tele (Dom' Term Type) -> Int
    forall a. Sized a => a -> Int
    size Tele (Dom' Term Type)
    delta2) (Literal -> DeBruijnPattern
    forall a. Literal -> Pattern' a
    litP Literal
    lit)
              -- Andreas, 2015-06-13 Literals are closed, so no need to raise them!
              -- rho    = liftS (size delta2) $ singletonS 0 (Lit lit)
              -- rho    = [ var i | i <- [0..size delta2 - 1] ]
              --       ++ [ raise (size delta2) $ Lit lit ]
              --       ++ [ var i | i <- [size delta2 ..] ]
              eqs' :: [ProblemEq]
    eqs'     = Substitution' DeBruijnPattern -> [ProblemEq] -> [ProblemEq]
    forall a. TermSubst a => Substitution' DeBruijnPattern -> a -> a
    applyPatSubst Substitution' DeBruijnPattern
    rho ([ProblemEq] -> [ProblemEq]) -> [ProblemEq] -> [ProblemEq]
    forall a b. (a -> b) -> a -> b
    $ Problem a
    problem Problem a -> Lens' [ProblemEq] (Problem a) -> [ProblemEq]
    forall o i. o -> Lens' i o -> i
    ^. forall a. Lens' [ProblemEq] (Problem a)
    Lens' [ProblemEq] (Problem a)
    problemEqs
              ip' :: [NamedArg DeBruijnPattern]
    ip'      = Substitution' (SubstArg [NamedArg DeBruijnPattern])
    -> [NamedArg DeBruijnPattern] -> [NamedArg DeBruijnPattern]
    forall a. Subst a => Substitution' (SubstArg a) -> a -> a
    applySubst Substitution' DeBruijnPattern
    Substitution' (SubstArg [NamedArg DeBruijnPattern])
    rho [NamedArg DeBruijnPattern]
    ip
              target' :: Arg Type
    target'  = Substitution' DeBruijnPattern -> Arg Type -> Arg Type
    forall a. TermSubst a => Substitution' DeBruijnPattern -> a -> a
    applyPatSubst Substitution' DeBruijnPattern
    rho Arg Type
    target

          -- Andreas, 2010-09-07 cannot split on irrelevant args
          Bool -> ExceptT TCErr tcm () -> ExceptT TCErr tcm ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless (ArgInfo -> Bool
    forall a. LensRelevance a => a -> Bool
    usableRelevance ArgInfo
    info) (ExceptT TCErr tcm () -> ExceptT TCErr tcm ())
    -> ExceptT TCErr tcm () -> ExceptT TCErr tcm ()
    forall a b. (a -> b) -> a -> b
    $
            Tele (Dom' Term Type)
    -> ExceptT TCErr tcm () -> ExceptT TCErr tcm ()
    forall b (m :: * -> *) a.
    (AddContext b, MonadAddContext m) =>
    b -> m a -> m a
    addContext Tele (Dom' Term Type)
    delta1 (ExceptT TCErr tcm () -> ExceptT TCErr tcm ())
    -> ExceptT TCErr tcm () -> ExceptT TCErr tcm ()
    forall a b. (a -> b) -> a -> b
    $ TypeError -> ExceptT TCErr tcm ()
    forall (m :: * -> *) a.
    (HasCallStack, ReadTCState m, MonadError TCErr m, MonadTCEnv m) =>
    TypeError -> m a
    softTypeError (TypeError -> ExceptT TCErr tcm ())
    -> TypeError -> ExceptT TCErr tcm ()
    forall a b. (a -> b) -> a -> b
    $ Dom' Term Type -> TypeError
    SplitOnIrrelevant Dom' Term Type
    dom

          -- Andreas, 2018-10-17, we can however split on erased things
          -- if there is a single constructor (checked in Coverage).
          --
          -- Thus, no checking of (usableQuantity info) here.

          ExceptT TCErr tcm Bool
    -> ExceptT TCErr tcm () -> ExceptT TCErr tcm ()
    forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
    unlessM (ArgInfo -> ExceptT TCErr tcm Bool
    forall (m :: * -> *) a.
    (HasOptions m, LensCohesion a) =>
    a -> m Bool
    splittableCohesion ArgInfo
    info) (ExceptT TCErr tcm () -> ExceptT TCErr tcm ())
    -> ExceptT TCErr tcm () -> ExceptT TCErr tcm ()
    forall a b. (a -> b) -> a -> b
    $
            Tele (Dom' Term Type)
    -> ExceptT TCErr tcm () -> ExceptT TCErr tcm ()
    forall b (m :: * -> *) a.
    (AddContext b, MonadAddContext m) =>
    b -> m a -> m a
    addContext Tele (Dom' Term Type)
    delta1 (ExceptT TCErr tcm () -> ExceptT TCErr tcm ())
    -> ExceptT TCErr tcm () -> ExceptT TCErr tcm ()
    forall a b. (a -> b) -> a -> b
    $ TypeError -> ExceptT TCErr tcm ()
    forall (m :: * -> *) a.
    (HasCallStack, ReadTCState m, MonadError TCErr m, MonadTCEnv m) =>
    TypeError -> m a
    softTypeError (TypeError -> ExceptT TCErr tcm ())
    -> TypeError -> ExceptT TCErr tcm ()
    forall a b. (a -> b) -> a -> b
    $ Dom' Term Type -> TypeError
    SplitOnUnusableCohesion Dom' Term Type
    dom

          -- check that a is indeed the type of lit (otherwise fail softly)
          -- if not, fail softly since it could be instantiated by a later split.
          TCMT IO () -> ExceptT TCErr tcm ()
    forall (m :: * -> *) a.
    (MonadTCM m, MonadError TCErr m) =>
    TCM a -> m a
    suspendErrors (TCMT IO () -> ExceptT TCErr tcm ())
    -> TCMT IO () -> ExceptT TCErr tcm ()
    forall a b. (a -> b) -> a -> b
    $ Type -> Type -> TCMT IO ()
    forall (m :: * -> *). MonadConversion m => Type -> Type -> m ()
    equalType Type
    a (Type -> TCMT IO ()) -> TCMT IO Type -> TCMT IO ()
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< Literal -> TCMT IO Type
    forall (m :: * -> *).
    (HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
    Literal -> m Type
    litType Literal
    lit

          -- Compute the new state
          let problem' :: Problem a
    problem' = Lens' [ProblemEq] (Problem a) -> LensSet [ProblemEq] (Problem a)
    forall i o. Lens' i o -> LensSet i o
    set forall a. Lens' [ProblemEq] (Problem a)
    Lens' [ProblemEq] (Problem a)
    problemEqs [ProblemEq]
    eqs' Problem a
    problem
          TCM (LHSState a) -> ExceptT TCErr tcm (LHSState a)
    forall (tcm :: * -> *) a. MonadTCM tcm => TCM a -> tcm a
    liftTCM (TCM (LHSState a) -> ExceptT TCErr tcm (LHSState a))
    -> TCM (LHSState a) -> ExceptT TCErr tcm (LHSState a)
    forall a b. (a -> b) -> a -> b
    $ LHSState a -> TCM (LHSState a)
    forall a. LHSState a -> TCM (LHSState a)
    updateLHSState (Tele (Dom' Term Type)
    -> [NamedArg DeBruijnPattern]
    -> Problem a
    -> Arg Type
    -> [Maybe Int]
    -> LHSState a
    forall a.
    Tele (Dom' Term Type)
    -> [NamedArg DeBruijnPattern]
    -> Problem a
    -> Arg Type
    -> [Maybe Int]
    -> LHSState a
    LHSState Tele (Dom' Term Type)
    delta' [NamedArg DeBruijnPattern]
    ip' Problem a
    problem' Arg Type
    target' [Maybe Int]
    psplit)

        splitCon :: Telescope      -- The types of arguments before the one we split on
                 -> Dom Type       -- The type of the constructor we split on
                 -> Abs Telescope  -- The types of arguments after the one we split on
                 -> A.Pattern      -- The pattern written by the user
                 -> Maybe AmbiguousQName  -- @Just c@ for a (possibly ambiguous) constructor @c@, or
                                          -- @Nothing@ for a record pattern
                 -> ExceptT TCErr tcm (LHSState a)
        splitCon :: Tele (Dom' Term Type)
    -> Dom' Term Type
    -> Abs (Tele (Dom' Term Type))
    -> Pattern
    -> Maybe AmbiguousQName
    -> ExceptT TCErr tcm (LHSState a)
    splitCon Tele (Dom' Term Type)
    delta1 dom :: Dom' Term Type
    dom@Dom{domInfo :: forall t e. Dom' t e -> ArgInfo
    domInfo = ArgInfo
    info, unDom :: forall t e. Dom' t e -> e
    unDom = Type
    a} Abs (Tele (Dom' Term Type))
    adelta2 Pattern
    focusPat Maybe AmbiguousQName
    ambC = do
          let delta2 :: Tele (Dom' Term Type)
    delta2 = Abs (Tele (Dom' Term Type)) -> Tele (Dom' Term Type)
    forall a. Subst a => Abs a -> a
    absBody Abs (Tele (Dom' Term Type))
    adelta2

          [Char] -> Int -> TCMT IO Doc -> ExceptT TCErr tcm ()
    forall (m :: * -> *).
    MonadDebug m =>
    [Char] -> Int -> TCMT IO Doc -> m ()
    reportSDoc [Char]
    "tc.lhs.split" Int
    10 (TCMT IO Doc -> ExceptT TCErr tcm ())
    -> TCMT IO Doc -> ExceptT TCErr tcm ()
    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
    "checking lhs"
            , 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
    "tel =" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> Tele (Dom' Term Type) -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM Tele (Dom' Term Type)
    tel
            , 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
    "rel =" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> [Char] -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => [Char] -> m Doc
    text (Relevance -> [Char]
    forall a. Show a => a -> [Char]
    show (Relevance -> [Char]) -> Relevance -> [Char]
    forall a b. (a -> b) -> a -> b
    $ ArgInfo -> Relevance
    forall a. LensRelevance a => a -> Relevance
    getRelevance ArgInfo
    info)
            , 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
    "mod =" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> [Char] -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => [Char] -> m Doc
    text (Modality -> [Char]
    forall a. Show a => a -> [Char]
    show (Modality -> [Char]) -> Modality -> [Char]
    forall a b. (a -> b) -> a -> b
    $ ArgInfo -> Modality
    forall a. LensModality a => a -> Modality
    getModality  ArgInfo
    info)
            ]

          [Char] -> Int -> TCMT IO Doc -> ExceptT TCErr tcm ()
    forall (m :: * -> *).
    MonadDebug m =>
    [Char] -> Int -> TCMT IO Doc -> m ()
    reportSDoc [Char]
    "tc.lhs.split" Int
    15 (TCMT IO Doc -> ExceptT TCErr tcm ())
    -> TCMT IO Doc -> ExceptT TCErr tcm ()
    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
    "split problem"
            , 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
    "delta1 = " TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> Tele (Dom' Term Type) -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM Tele (Dom' Term Type)
    delta1
              , TCMT IO Doc
    "a      = " TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> Tele (Dom' Term Type) -> TCMT IO Doc -> TCMT IO Doc
    forall b (m :: * -> *) a.
    (AddContext b, MonadAddContext m) =>
    b -> m a -> m a
    addContext Tele (Dom' Term Type)
    delta1 (Type -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM Type
    a)
              , TCMT IO Doc
    "delta2 = " TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> Tele (Dom' Term Type) -> TCMT IO Doc -> TCMT IO Doc
    forall b (m :: * -> *) a.
    (AddContext b, MonadAddContext m) =>
    b -> m a -> m a
    addContext Tele (Dom' Term Type)
    delta1
                                  (([Char], Dom' Term Type) -> TCMT IO Doc -> TCMT IO Doc
    forall b (m :: * -> *) a.
    (AddContext b, MonadAddContext m) =>
    b -> m a -> m a
    addContext ([Char]
    "x" :: String, Dom' Term Type
    dom) (Tele (Dom' Term Type) -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM Tele (Dom' Term Type)
    delta2))
              ]
            ]

          -- We cannot split on (shape-)irrelevant arguments.
          [Char] -> Int -> [Char] -> ExceptT TCErr tcm ()
    forall (m :: * -> *).
    MonadDebug m =>
    [Char] -> Int -> [Char] -> m ()
    reportSLn [Char]
    "tc.lhs.split" Int
    30 ([Char] -> ExceptT TCErr tcm ()) -> [Char] -> ExceptT TCErr tcm ()
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "split ConP: relevance is " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Relevance -> [Char]
    forall a. Show a => a -> [Char]
    show (ArgInfo -> Relevance
    forall a. LensRelevance a => a -> Relevance
    getRelevance ArgInfo
    info)
          Bool -> ExceptT TCErr tcm () -> ExceptT TCErr tcm ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless (ArgInfo -> Bool
    forall a. LensRelevance a => a -> Bool
    usableRelevance ArgInfo
    info) (ExceptT TCErr tcm () -> ExceptT TCErr tcm ())
    -> ExceptT TCErr tcm () -> ExceptT TCErr tcm ()
    forall a b. (a -> b) -> a -> b
    $ Tele (Dom' Term Type)
    -> ExceptT TCErr tcm () -> ExceptT TCErr tcm ()
    forall b (m :: * -> *) a.
    (AddContext b, MonadAddContext m) =>
    b -> m a -> m a
    addContext Tele (Dom' Term Type)
    delta1 (ExceptT TCErr tcm () -> ExceptT TCErr tcm ())
    -> ExceptT TCErr tcm () -> ExceptT TCErr tcm ()
    forall a b. (a -> b) -> a -> b
    $
            TypeError -> ExceptT TCErr tcm ()
    forall (m :: * -> *) a.
    (HasCallStack, ReadTCState m, MonadError TCErr m, MonadTCEnv m) =>
    TypeError -> m a
    softTypeError (TypeError -> ExceptT TCErr tcm ())
    -> TypeError -> ExceptT TCErr tcm ()
    forall a b. (a -> b) -> a -> b
    $ Dom' Term Type -> TypeError
    SplitOnIrrelevant Dom' Term Type
    dom

          -- Andreas, 2018-10-17, we can however split on erased things
          -- if there is a single constructor (checked in Coverage).
          --
          -- Thus, no checking of (usableQuantity info) here.

          ExceptT TCErr tcm Bool
    -> ExceptT TCErr tcm () -> ExceptT TCErr tcm ()
    forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
    unlessM (ArgInfo -> ExceptT TCErr tcm Bool
    forall (m :: * -> *) a.
    (HasOptions m, LensCohesion a) =>
    a -> m Bool
    splittableCohesion ArgInfo
    info) (ExceptT TCErr tcm () -> ExceptT TCErr tcm ())
    -> ExceptT TCErr tcm () -> ExceptT TCErr tcm ()
    forall a b. (a -> b) -> a -> b
    $
            Tele (Dom' Term Type)
    -> ExceptT TCErr tcm () -> ExceptT TCErr tcm ()
    forall b (m :: * -> *) a.
    (AddContext b, MonadAddContext m) =>
    b -> m a -> m a
    addContext Tele (Dom' Term Type)
    delta1 (ExceptT TCErr tcm () -> ExceptT TCErr tcm ())
    -> ExceptT TCErr tcm () -> ExceptT TCErr tcm ()
    forall a b. (a -> b) -> a -> b
    $ TypeError -> ExceptT TCErr tcm ()
    forall (m :: * -> *) a.
    (HasCallStack, ReadTCState m, MonadError TCErr m, MonadTCEnv m) =>
    TypeError -> m a
    softTypeError (TypeError -> ExceptT TCErr tcm ())
    -> TypeError -> ExceptT TCErr tcm ()
    forall a b. (a -> b) -> a -> b
    $ Dom' Term Type -> TypeError
    SplitOnUnusableCohesion Dom' Term Type
    dom

          -- We should be at a data/record type
          (DataOrRecord
    dr, QName
    d, Args
    pars, Args
    ixs) <- Tele (Dom' Term Type)
    -> ExceptT TCErr tcm (DataOrRecord, QName, Args, Args)
    -> ExceptT TCErr tcm (DataOrRecord, QName, Args, Args)
    forall b (m :: * -> *) a.
    (AddContext b, MonadAddContext m) =>
    b -> m a -> m a
    addContext Tele (Dom' Term Type)
    delta1 (ExceptT TCErr tcm (DataOrRecord, QName, Args, Args)
     -> ExceptT TCErr tcm (DataOrRecord, QName, Args, Args))
    -> ExceptT TCErr tcm (DataOrRecord, QName, Args, Args)
    -> ExceptT TCErr tcm (DataOrRecord, QName, Args, Args)
    forall a b. (a -> b) -> a -> b
    $ Type -> ExceptT TCErr tcm (DataOrRecord, QName, Args, Args)
    forall (m :: * -> *).
    (MonadTCM m, PureTCM m) =>
    Type -> ExceptT TCErr m (DataOrRecord, QName, Args, Args)
    isDataOrRecordType Type
    a
          let isRec :: Bool
    isRec = case DataOrRecord
    dr of
                IsData{}   -> Bool
    False
                IsRecord{} -> Bool
    True

          QName -> DataOrRecord -> ExceptT TCErr tcm ()
    forall (m :: * -> *).
    MonadTCError m =>
    QName -> DataOrRecord -> m ()
    checkMatchingAllowed QName
    d DataOrRecord
    dr  -- No splitting on coinductive constructors.
          Tele (Dom' Term Type)
    -> ExceptT TCErr tcm () -> ExceptT TCErr tcm ()
    forall b (m :: * -> *) a.
    (AddContext b, MonadAddContext m) =>
    b -> m a -> m a
    addContext Tele (Dom' Term Type)
    delta1 (ExceptT TCErr tcm () -> ExceptT TCErr tcm ())
    -> ExceptT TCErr tcm () -> ExceptT TCErr tcm ()
    forall a b. (a -> b) -> a -> b
    $ DataOrRecord
    -> Type
    -> Tele (Dom' Term Type)
    -> Maybe (Arg Type)
    -> ExceptT TCErr tcm ()
    forall (m :: * -> *) a ty.
    (MonadTCM m, PureTCM m, MonadError TCErr m, LensSort a,
     PrettyTCM a, LensSort ty, PrettyTCM ty) =>
    DataOrRecord -> a -> Tele (Dom' Term Type) -> Maybe ty -> m ()
    checkSortOfSplitVar DataOrRecord
    dr Type
    a Tele (Dom' Term Type)
    delta2 (Arg Type -> Maybe (Arg Type)
    forall a. a -> Maybe a
    Just Arg Type
    target)

          -- Jesper, 2019-09-13: if the data type we split on is a strict
          -- set, we locally enable --with-K during unification.
          TCMT IO UnificationResult -> TCMT IO UnificationResult
    withKIfStrict <- Sort' Term -> ExceptT TCErr tcm (Sort' Term)
    forall a (m :: * -> *). (Reduce a, MonadReduce m) => a -> m a
    reduce (Type -> Sort' Term
    forall a. LensSort a => a -> Sort' Term
    getSort Type
    a) ExceptT TCErr tcm (Sort' Term)
    -> (Sort' Term
        -> ExceptT
             TCErr tcm (TCMT IO UnificationResult -> TCMT IO UnificationResult))
    -> ExceptT
         TCErr tcm (TCMT IO UnificationResult -> TCMT IO UnificationResult)
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \case
            SSet{} -> (TCMT IO UnificationResult -> TCMT IO UnificationResult)
    -> ExceptT
         TCErr tcm (TCMT IO UnificationResult -> TCMT IO UnificationResult)
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((TCMT IO UnificationResult -> TCMT IO UnificationResult)
     -> ExceptT
          TCErr tcm (TCMT IO UnificationResult -> TCMT IO UnificationResult))
    -> (TCMT IO UnificationResult -> TCMT IO UnificationResult)
    -> ExceptT
         TCErr tcm (TCMT IO UnificationResult -> TCMT IO UnificationResult)
    forall a b. (a -> b) -> a -> b
    $ Lens' Bool TCEnv
    -> (Bool -> Bool)
    -> TCMT IO UnificationResult
    -> TCMT IO UnificationResult
    forall (m :: * -> *) a b.
    MonadTCEnv m =>
    Lens' a TCEnv -> (a -> a) -> m b -> m b
    locallyTC Lens' Bool TCEnv
    eSplitOnStrict ((Bool -> Bool)
     -> TCMT IO UnificationResult -> TCMT IO UnificationResult)
    -> (Bool -> Bool)
    -> TCMT IO UnificationResult
    -> TCMT IO UnificationResult
    forall a b. (a -> b) -> a -> b
    $ Bool -> Bool -> Bool
    forall a b. a -> b -> a
    const Bool
    True
            Sort' Term
    _      -> (TCMT IO UnificationResult -> TCMT IO UnificationResult)
    -> ExceptT
         TCErr tcm (TCMT IO UnificationResult -> TCMT IO UnificationResult)
    forall (m :: * -> *) a. Monad m => a -> m a
    return TCMT IO UnificationResult -> TCMT IO UnificationResult
    forall a. a -> a
    id

          -- The constructor should construct an element of this datatype
          (ConHead
    c :: ConHead, Type
    b :: Type) <- TCM (ConHead, Type) -> ExceptT TCErr tcm (ConHead, Type)
    forall (tcm :: * -> *) a. MonadTCM tcm => TCM a -> tcm a
    liftTCM (TCM (ConHead, Type) -> ExceptT TCErr tcm (ConHead, Type))
    -> TCM (ConHead, Type) -> ExceptT TCErr tcm (ConHead, Type)
    forall a b. (a -> b) -> a -> b
    $ Tele (Dom' Term Type) -> TCM (ConHead, Type) -> TCM (ConHead, Type)
    forall b (m :: * -> *) a.
    (AddContext b, MonadAddContext m) =>
    b -> m a -> m a
    addContext Tele (Dom' Term Type)
    delta1 (TCM (ConHead, Type) -> TCM (ConHead, Type))
    -> TCM (ConHead, Type) -> TCM (ConHead, Type)
    forall a b. (a -> b) -> a -> b
    $ case Maybe AmbiguousQName
    ambC of
            Just AmbiguousQName
    ambC -> AmbiguousQName -> QName -> Args -> TCM (ConHead, Type)
    disambiguateConstructor AmbiguousQName
    ambC QName
    d Args
    pars
            Maybe AmbiguousQName
    Nothing   -> QName -> Args -> Type -> TCM (ConHead, Type)
    getRecordConstructor QName
    d Args
    pars Type
    a

          -- Don't split on lazy (non-eta) constructor
          case Pattern
    focusPat of
            A.ConP ConPatInfo
    cpi AmbiguousQName
    _ [NamedArg Pattern]
    _ | ConPatInfo -> ConPatLazy
    conPatLazy ConPatInfo
    cpi ConPatLazy -> ConPatLazy -> Bool
    forall a. Eq a => a -> a -> Bool
    == ConPatLazy
    ConPatLazy ->
              ExceptT TCErr tcm Bool
    -> ExceptT TCErr tcm () -> ExceptT TCErr tcm ()
    forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
    unlessM (QName -> ExceptT TCErr tcm Bool
    forall (m :: * -> *). HasConstInfo m => QName -> m Bool
    isEtaRecord QName
    d) (ExceptT TCErr tcm () -> ExceptT TCErr tcm ())
    -> ExceptT TCErr tcm () -> ExceptT TCErr tcm ()
    forall a b. (a -> b) -> a -> b
    $ TypeError -> ExceptT TCErr tcm ()
    forall (m :: * -> *) a.
    (HasCallStack, ReadTCState m, MonadError TCErr m, MonadTCEnv m) =>
    TypeError -> m a
    softTypeError (TypeError -> ExceptT TCErr tcm ())
    -> TypeError -> ExceptT TCErr tcm ()
    forall a b. (a -> b) -> a -> b
    $ Pattern -> TypeError
    ForcedConstructorNotInstantiated Pattern
    focusPat
            Pattern
    _ -> () -> ExceptT TCErr tcm ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

          -- The type of the constructor will end in an application of the datatype
          (TelV Tele (Dom' Term Type)
    gamma (El Sort' Term
    _ Term
    ctarget), Boundary
    boundary) <- TCM (TelV Type, Boundary)
    -> ExceptT TCErr tcm (TelV Type, Boundary)
    forall (tcm :: * -> *) a. MonadTCM tcm => TCM a -> tcm a
    liftTCM (TCM (TelV Type, Boundary)
     -> ExceptT TCErr tcm (TelV Type, Boundary))
    -> TCM (TelV Type, Boundary)
    -> ExceptT TCErr tcm (TelV Type, Boundary)
    forall a b. (a -> b) -> a -> b
    $ Type -> TCM (TelV Type, Boundary)
    forall (m :: * -> *). PureTCM m => Type -> m (TelV Type, Boundary)
    telViewPathBoundaryP Type
    b
          let Def QName
    d' Elims
    es' = Term
    ctarget
              cixs :: Args
    cixs = Int -> Args -> Args
    forall a. Int -> [a] -> [a]
    drop (Args -> Int
    forall a. Sized a => a -> Int
    size Args
    pars) (Args -> Args) -> Args -> Args
    forall a b. (a -> b) -> a -> b
    $ Args -> Maybe Args -> Args
    forall a. a -> Maybe a -> a
    fromMaybe Args
    forall a. HasCallStack => a
    __IMPOSSIBLE__ (Maybe Args -> Args) -> Maybe Args -> Args
    forall a b. (a -> b) -> a -> b
    $ Elims -> Maybe Args
    forall a. [Elim' a] -> Maybe [Arg a]
    allApplyElims Elims
    es'

          -- Δ₁Γ ⊢ boundary
          [Char] -> Int -> TCMT IO Doc -> ExceptT TCErr tcm ()
    forall (m :: * -> *).
    MonadDebug m =>
    [Char] -> Int -> TCMT IO Doc -> m ()
    reportSDoc [Char]
    "tc.lhs.split.con" Int
    50 (TCMT IO Doc -> ExceptT TCErr tcm ())
    -> TCMT IO Doc -> ExceptT TCErr tcm ()
    forall a b. (a -> b) -> a -> b
    $ [Char] -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => [Char] -> m Doc
    text [Char]
    "  boundary = " TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> Boundary -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM Boundary
    boundary

          Bool -> ExceptT TCErr tcm () -> ExceptT TCErr tcm ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless (QName
    d QName -> QName -> Bool
    forall a. Eq a => a -> a -> Bool
    == QName
    d') {-'-} ExceptT TCErr tcm ()
    forall a. HasCallStack => a
    __IMPOSSIBLE__

          -- Get names for the constructor arguments from the user patterns
          Tele (Dom' Term Type)
    gamma <- TCMT IO (Tele (Dom' Term Type))
    -> ExceptT TCErr tcm (Tele (Dom' Term Type))
    forall (tcm :: * -> *) a. MonadTCM tcm => TCM a -> tcm a
    liftTCM (TCMT IO (Tele (Dom' Term Type))
     -> ExceptT TCErr tcm (Tele (Dom' Term Type)))
    -> TCMT IO (Tele (Dom' Term Type))
    -> ExceptT TCErr tcm (Tele (Dom' Term Type))
    forall a b. (a -> b) -> a -> b
    $ case Pattern
    focusPat of
            A.ConP ConPatInfo
    _ AmbiguousQName
    _ [NamedArg Pattern]
    ps -> do
              [NamedArg Pattern]
    ps <- ExpandHidden
    -> [NamedArg Pattern]
    -> Tele (Dom' Term Type)
    -> TCMT IO [NamedArg Pattern]
    forall (m :: * -> *).
    (PureTCM m, MonadError TCErr m, MonadFresh NameId m,
     MonadTrace m) =>
    ExpandHidden
    -> [NamedArg Pattern]
    -> Tele (Dom' Term Type)
    -> m [NamedArg Pattern]
    insertImplicitPatterns ExpandHidden
    ExpandLast [NamedArg Pattern]
    ps Tele (Dom' Term Type)
    gamma
              Tele (Dom' Term Type) -> TCMT IO (Tele (Dom' Term Type))
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Tele (Dom' Term Type) -> TCMT IO (Tele (Dom' Term Type)))
    -> Tele (Dom' Term Type) -> TCMT IO (Tele (Dom' Term Type))
    forall a b. (a -> b) -> a -> b
    $ [NamedArg Pattern]
    -> Tele (Dom' Term Type) -> Tele (Dom' Term Type)
    useNamesFromPattern [NamedArg Pattern]
    ps Tele (Dom' Term Type)
    gamma
            A.RecP PatInfo
    _ [FieldAssignment' Pattern]
    fs -> do
              [Arg Name]
    axs <- (Dom' Term Name -> Arg Name) -> [Dom' Term Name] -> [Arg Name]
    forall a b. (a -> b) -> [a] -> [b]
    map Dom' Term Name -> Arg Name
    forall t a. Dom' t a -> Arg a
    argFromDom ([Dom' Term Name] -> [Arg Name])
    -> (Definition -> [Dom' Term Name]) -> Definition -> [Arg Name]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Defn -> [Dom' Term Name]
    recordFieldNames (Defn -> [Dom' Term Name])
    -> (Definition -> Defn) -> Definition -> [Dom' Term Name]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Definition -> Defn
    theDef (Definition -> [Arg Name])
    -> TCMT IO Definition -> TCMT IO [Arg Name]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> QName -> TCMT IO Definition
    forall (m :: * -> *). HasConstInfo m => QName -> m Definition
    getConstInfo QName
    d
              [NamedArg Pattern]
    ps <- QName
    -> (Name -> Pattern)
    -> [FieldAssignment' Pattern]
    -> [Arg Name]
    -> TCMT IO [NamedArg Pattern]
    forall a.
    HasRange a =>
    QName
    -> (Name -> a)
    -> [FieldAssignment' a]
    -> [Arg Name]
    -> TCM [NamedArg a]
    insertMissingFieldsFail QName
    d (Pattern -> Name -> Pattern
    forall a b. a -> b -> a
    const (Pattern -> Name -> Pattern) -> Pattern -> Name -> Pattern
    forall a b. (a -> b) -> a -> b
    $ PatInfo -> Pattern
    forall e. PatInfo -> Pattern' e
    A.WildP PatInfo
    patNoRange) [FieldAssignment' Pattern]
    fs [Arg Name]
    axs
              [NamedArg Pattern]
    ps <- ExpandHidden
    -> [NamedArg Pattern]
    -> Tele (Dom' Term Type)
    -> TCMT IO [NamedArg Pattern]
    forall (m :: * -> *).
    (PureTCM m, MonadError TCErr m, MonadFresh NameId m,
     MonadTrace m) =>
    ExpandHidden
    -> [NamedArg Pattern]
    -> Tele (Dom' Term Type)
    -> m [NamedArg Pattern]
    insertImplicitPatterns ExpandHidden
    ExpandLast [NamedArg Pattern]
    ps Tele (Dom' Term Type)
    gamma
              Tele (Dom' Term Type) -> TCMT IO (Tele (Dom' Term Type))
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Tele (Dom' Term Type) -> TCMT IO (Tele (Dom' Term Type)))
    -> Tele (Dom' Term Type) -> TCMT IO (Tele (Dom' Term Type))
    forall a b. (a -> b) -> a -> b
    $ [NamedArg Pattern]
    -> Tele (Dom' Term Type) -> Tele (Dom' Term Type)
    useNamesFromPattern [NamedArg Pattern]
    ps Tele (Dom' Term Type)
    gamma
            Pattern
    _ -> TCMT IO (Tele (Dom' Term Type))
    forall a. HasCallStack => a
    __IMPOSSIBLE__

          -- Andreas 2010-09-07  propagate relevance info to new vars
          -- Andreas 2018-10-17  propagate modality
          let updMod :: Modality -> Modality
    updMod = Modality -> Modality -> Modality
    composeModality (ArgInfo -> Modality
    forall a. LensModality a => a -> Modality
    getModality ArgInfo
    info)
          Tele (Dom' Term Type)
    gamma <- Tele (Dom' Term Type) -> ExceptT TCErr tcm (Tele (Dom' Term Type))
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Tele (Dom' Term Type)
     -> ExceptT TCErr tcm (Tele (Dom' Term Type)))
    -> Tele (Dom' Term Type)
    -> ExceptT TCErr tcm (Tele (Dom' Term Type))
    forall a b. (a -> b) -> a -> b
    $ (Modality -> Modality) -> Dom' Term Type -> Dom' Term Type
    forall a. LensModality a => (Modality -> Modality) -> a -> a
    mapModality Modality -> Modality
    updMod (Dom' Term Type -> Dom' Term Type)
    -> Tele (Dom' Term Type) -> Tele (Dom' Term Type)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Tele (Dom' Term Type)
    gamma

          -- Get the type of the datatype.
          Type
    da <- (Type -> Args -> Type
    `piApply` Args
    pars) (Type -> Type) -> (Definition -> Type) -> Definition -> Type
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Definition -> Type
    defType (Definition -> Type)
    -> ExceptT TCErr tcm Definition -> ExceptT TCErr tcm Type
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> QName -> ExceptT TCErr tcm Definition
    forall (m :: * -> *). HasConstInfo m => QName -> m Definition
    getConstInfo QName
    d
          [Char] -> Int -> TCMT IO Doc -> ExceptT TCErr tcm ()
    forall (m :: * -> *).
    MonadDebug m =>
    [Char] -> Int -> TCMT IO Doc -> m ()
    reportSDoc [Char]
    "tc.lhs.split" Int
    30 (TCMT IO Doc -> ExceptT TCErr tcm ())
    -> TCMT IO Doc -> ExceptT TCErr tcm ()
    forall a b. (a -> b) -> a -> b
    $ TCMT IO Doc
    "  da = " 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
    da

          [Char] -> Int -> TCMT IO Doc -> ExceptT TCErr tcm ()
    forall (m :: * -> *).
    MonadDebug m =>
    [Char] -> Int -> TCMT IO Doc -> m ()
    reportSDoc [Char]
    "tc.lhs.top" Int
    15 (TCMT IO Doc -> ExceptT TCErr tcm ())
    -> TCMT IO Doc -> ExceptT TCErr tcm ()
    forall a b. (a -> b) -> a -> b
    $ Tele (Dom' Term Type) -> TCMT IO Doc -> TCMT IO Doc
    forall b (m :: * -> *) a.
    (AddContext b, MonadAddContext m) =>
    b -> m a -> m a
    addContext Tele (Dom' Term Type)
    delta1 (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
    "preparing to unify"
                , 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
    "c      =" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> ConHead -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM ConHead
    c 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 a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM Type
    b
                  , TCMT IO Doc
    "d      =" 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 (QName -> Elims -> Term
    Def QName
    d ((Arg Term -> Elim' Term) -> Args -> Elims
    forall a b. (a -> b) -> [a] -> [b]
    map Arg Term -> Elim' Term
    forall a. Arg a -> Elim' a
    Apply Args
    pars)) 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 a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM Type
    da
                  , TCMT IO Doc
    "isRec  =" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> ([Char] -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => [Char] -> m Doc
    text ([Char] -> TCMT IO Doc) -> (Bool -> [Char]) -> Bool -> TCMT IO Doc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Bool -> [Char]
    forall a. Show a => a -> [Char]
    show) Bool
    isRec
                  , TCMT IO Doc
    "gamma  =" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> Tele (Dom' Term Type) -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM Tele (Dom' Term Type)
    gamma
                  , TCMT IO Doc
    "pars   =" 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 :: * -> *). Functor m => m Doc -> m Doc
    brackets ([TCMT IO Doc] -> TCMT IO Doc
    forall (m :: * -> *) (t :: * -> *).
    (Applicative m, Foldable t) =>
    t (m Doc) -> m Doc
    fsep ([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] -> [TCMT IO Doc]
    forall (m :: * -> *) (t :: * -> *).
    (Applicative m, Semigroup (m Doc), Foldable t) =>
    m Doc -> t (m Doc) -> [m Doc]
    punctuate TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc
    comma ([TCMT IO Doc] -> [TCMT IO Doc]) -> [TCMT IO Doc] -> [TCMT IO Doc]
    forall a b. (a -> b) -> a -> b
    $ (Arg Term -> TCMT IO Doc) -> Args -> [TCMT IO Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map Arg Term -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM Args
    pars)
                  , TCMT IO Doc
    "ixs    =" 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 :: * -> *). Functor m => m Doc -> m Doc
    brackets ([TCMT IO Doc] -> TCMT IO Doc
    forall (m :: * -> *) (t :: * -> *).
    (Applicative m, Foldable t) =>
    t (m Doc) -> m Doc
    fsep ([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] -> [TCMT IO Doc]
    forall (m :: * -> *) (t :: * -> *).
    (Applicative m, Semigroup (m Doc), Foldable t) =>
    m Doc -> t (m Doc) -> [m Doc]
    punctuate TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc
    comma ([TCMT IO Doc] -> [TCMT IO Doc]) -> [TCMT IO Doc] -> [TCMT IO Doc]
    forall a b. (a -> b) -> a -> b
    $ (Arg Term -> TCMT IO Doc) -> Args -> [TCMT IO Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map Arg Term -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM Args
    ixs)
                  , TCMT IO Doc
    "cixs   =" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> Tele (Dom' Term Type) -> TCMT IO Doc -> TCMT IO Doc
    forall b (m :: * -> *) a.
    (AddContext b, MonadAddContext m) =>
    b -> m a -> m a
    addContext Tele (Dom' Term Type)
    gamma (TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Functor m => m Doc -> m Doc
    brackets ([TCMT IO Doc] -> TCMT IO Doc
    forall (m :: * -> *) (t :: * -> *).
    (Applicative m, Foldable t) =>
    t (m Doc) -> m Doc
    fsep ([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] -> [TCMT IO Doc]
    forall (m :: * -> *) (t :: * -> *).
    (Applicative m, Semigroup (m Doc), Foldable t) =>
    m Doc -> t (m Doc) -> [m Doc]
    punctuate TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc
    comma ([TCMT IO Doc] -> [TCMT IO Doc]) -> [TCMT IO Doc] -> [TCMT IO Doc]
    forall a b. (a -> b) -> a -> b
    $ (Arg Term -> TCMT IO Doc) -> Args -> [TCMT IO Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map Arg Term -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM Args
    cixs))
                  ]
                ]
                     -- We ignore forcing for make-case
          [IsForced]
    cforced <- ExceptT TCErr tcm Bool
    -> ExceptT TCErr tcm [IsForced]
    -> ExceptT TCErr tcm [IsForced]
    -> ExceptT TCErr tcm [IsForced]
    forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
    ifM (Lens' Bool TCEnv -> ExceptT TCErr tcm Bool
    forall (m :: * -> *) a. MonadTCEnv m => Lens' a TCEnv -> m a
    viewTC Lens' Bool TCEnv
    eMakeCase) ([IsForced] -> ExceptT TCErr tcm [IsForced]
    forall (m :: * -> *) a. Monad m => a -> m a
    return []) (ExceptT TCErr tcm [IsForced] -> ExceptT TCErr tcm [IsForced])
    -> ExceptT TCErr tcm [IsForced] -> ExceptT TCErr tcm [IsForced]
    forall a b. (a -> b) -> a -> b
    $
                     {-else-} Definition -> [IsForced]
    defForced (Definition -> [IsForced])
    -> ExceptT TCErr tcm Definition -> ExceptT TCErr tcm [IsForced]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> QName -> ExceptT TCErr tcm Definition
    forall (m :: * -> *). HasConstInfo m => QName -> m Definition
    getConstInfo (ConHead -> QName
    conName ConHead
    c)

          let delta1Gamma :: Tele (Dom' Term Type)
    delta1Gamma = Tele (Dom' Term Type)
    delta1 Tele (Dom' Term Type)
    -> Tele (Dom' Term Type) -> Tele (Dom' Term Type)
    forall t. Abstract t => Tele (Dom' Term Type) -> t -> t
    `abstract` Tele (Dom' Term Type)
    gamma
              da' :: Type
    da'  = Int -> Type -> Type
    forall a. Subst a => Int -> a -> a
    raise (Tele (Dom' Term Type) -> Int
    forall a. Sized a => a -> Int
    size Tele (Dom' Term Type)
    gamma) Type
    da
              ixs' :: Args
    ixs' = Int -> Args -> Args
    forall a. Subst a => Int -> a -> a
    raise (Tele (Dom' Term Type) -> Int
    forall a. Sized a => a -> Int
    size Tele (Dom' Term Type)
    gamma) Args
    ixs
              -- Variables in Δ₁ are not forced, since the unifier takes care to not introduce forced
              -- variables.
              forced :: [IsForced]
    forced = Int -> IsForced -> [IsForced]
    forall a. Int -> a -> [a]
    replicate (Tele (Dom' Term Type) -> Int
    forall a. Sized a => a -> Int
    size Tele (Dom' Term Type)
    delta1) IsForced
    NotForced [IsForced] -> [IsForced] -> [IsForced]
    forall a. [a] -> [a] -> [a]
    ++ [IsForced]
    cforced

          -- All variables are flexible.
          let flex :: FlexibleVars
    flex = [IsForced] -> Tele (Dom' Term Type) -> FlexibleVars
    allFlexVars [IsForced]
    forced (Tele (Dom' Term Type) -> FlexibleVars)
    -> Tele (Dom' Term Type) -> FlexibleVars
    forall a b. (a -> b) -> a -> b
    $ Tele (Dom' Term Type)
    delta1Gamma

          -- Unify constructor target and given type (in Δ₁Γ)
          -- Given: Δ₁  ⊢ D pars : Φ → Setᵢ
          --        Δ₁  ⊢ c      : Γ → D pars cixs
          --        Δ₁  ⊢ ixs    : Φ
          --        Δ₁Γ ⊢ cixs   : Φ
          -- unification of ixs and cixs in context Δ₁Γ gives us a telescope Δ₁'
          -- and a substitution ρ₀ such that
          --        Δ₁' ⊢ ρ₀ : Δ₁Γ
          --        Δ₁' ⊢ (ixs)ρ₀ ≡ (cixs)ρ₀ : Φρ₀
          -- We can split ρ₀ into two parts ρ₁ and ρ₂, giving
          --        Δ₁' ⊢ ρ₁ : Δ₁
          --        Δ₁' ⊢ ρ₂ : Γρ₁
          -- Application of the constructor c gives
          --        Δ₁' ⊢ (c Γ)(ρ₀) : (D pars cixs)(ρ₁;ρ₂)
          -- We have
          --        cixs(ρ₁;ρ₂)
          --         ≡ cixs(ρ₀)   (since ρ₀=ρ₁;ρ₂)
          --         ≡ ixs(ρ₀)    (by unification)
          --         ≡ ixs(ρ₁)    (since ixs doesn't actually depend on Γ)
          -- so     Δ₁' ⊢ (c Γ)(ρ₀) : (D pars ixs)ρ₁
          -- Putting this together with ρ₁ gives ρ₃ = ρ₁;c ρ₂
          --        Δ₁' ⊢ ρ₁;(c Γ)(ρ₀) : Δ₁(x : D vs ws)
          -- and lifting over Δ₂ gives the final substitution ρ = ρ₃;Δ₂
          -- from Δ' = Δ₁';Δ₂ρ₃
          --        Δ' ⊢ ρ : Δ₁(x : D vs ws)Δ₂

          -- Andrea 2019-07-17 propagate the Cohesion to the equation telescope
          -- TODO: should we propagate the modality in general?
          -- See also Coverage checking.
          Type
    da' <- do
                 let updCoh :: Cohesion -> Cohesion
    updCoh = Cohesion -> Cohesion -> Cohesion
    composeCohesion (ArgInfo -> Cohesion
    forall a. LensCohesion a => a -> Cohesion
    getCohesion ArgInfo
    info)
                 TelV Tele (Dom' Term Type)
    tel Type
    dt <- Type -> ExceptT TCErr tcm (TelV Type)
    forall (m :: * -> *).
    (MonadReduce m, MonadAddContext m) =>
    Type -> m (TelV Type)
    telView Type
    da'
                 Type -> ExceptT TCErr tcm Type
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Type -> ExceptT TCErr tcm Type) -> Type -> ExceptT TCErr tcm Type
    forall a b. (a -> b) -> a -> b
    $ Tele (Dom' Term Type) -> Type -> Type
    forall t. Abstract t => Tele (Dom' Term Type) -> t -> t
    abstract ((Cohesion -> Cohesion) -> Dom' Term Type -> Dom' Term Type
    forall a. LensCohesion a => (Cohesion -> Cohesion) -> a -> a
    mapCohesion Cohesion -> Cohesion
    updCoh (Dom' Term Type -> Dom' Term Type)
    -> Tele (Dom' Term Type) -> Tele (Dom' Term Type)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Tele (Dom' Term Type)
    tel) Type
    a

          let stuck :: Maybe Blocker
    -> [UnificationFailure] -> ExceptT TCErr tcm (LHSState a)
    stuck Maybe Blocker
    b [UnificationFailure]
    errs = TypeError -> ExceptT TCErr tcm (LHSState a)
    forall (m :: * -> *) a.
    (HasCallStack, ReadTCState m, MonadError TCErr m, MonadTCEnv m) =>
    TypeError -> m a
    softTypeError (TypeError -> ExceptT TCErr tcm (LHSState a))
    -> TypeError -> ExceptT TCErr tcm (LHSState a)
    forall a b. (a -> b) -> a -> b
    $ SplitError -> TypeError
    SplitError (SplitError -> TypeError) -> SplitError -> TypeError
    forall a b. (a -> b) -> a -> b
    $
                Maybe Blocker
    -> QName
    -> Tele (Dom' Term Type)
    -> Args
    -> Args
    -> [UnificationFailure]
    -> SplitError
    UnificationStuck Maybe Blocker
    b (ConHead -> QName
    conName ConHead
    c) (Tele (Dom' Term Type)
    delta1 Tele (Dom' Term Type)
    -> Tele (Dom' Term Type) -> Tele (Dom' Term Type)
    forall t. Abstract t => Tele (Dom' Term Type) -> t -> t
    `abstract` Tele (Dom' Term Type)
    gamma) Args
    cixs Args
    ixs' [UnificationFailure]
    errs

          TCMT IO UnificationResult -> ExceptT TCErr tcm UnificationResult
    forall (tcm :: * -> *) a. MonadTCM tcm => TCM a -> tcm a
    liftTCM (TCMT IO UnificationResult -> TCMT IO UnificationResult
    withKIfStrict (TCMT IO UnificationResult -> TCMT IO UnificationResult)
    -> TCMT IO UnificationResult -> TCMT IO UnificationResult
    forall a b. (a -> b) -> a -> b
    $ Tele (Dom' Term Type)
    -> FlexibleVars
    -> Type
    -> Args
    -> Args
    -> TCMT IO UnificationResult
    forall (m :: * -> *).
    (PureTCM m, MonadBench m, BenchPhase m ~ Phase) =>
    Tele (Dom' Term Type)
    -> FlexibleVars -> Type -> Args -> Args -> m UnificationResult
    unifyIndices Tele (Dom' Term Type)
    delta1Gamma FlexibleVars
    flex Type
    da' Args
    cixs Args
    ixs') ExceptT TCErr tcm UnificationResult
    -> (UnificationResult -> ExceptT TCErr tcm (LHSState a))
    -> ExceptT TCErr tcm (LHSState a)
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \case

            -- Mismatch.  Report and abort.
            NoUnify NegativeUnification
    neg -> TypeError -> ExceptT TCErr tcm (LHSState a)
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCM m) =>
    TypeError -> m a
    hardTypeError (TypeError -> ExceptT TCErr tcm (LHSState a))
    -> TypeError -> ExceptT TCErr tcm (LHSState a)
    forall a b. (a -> b) -> a -> b
    $ QName -> NegativeUnification -> TypeError
    ImpossibleConstructor (ConHead -> QName
    conName ConHead
    c) NegativeUnification
    neg

            UnifyBlocked Blocker
    block -> Maybe Blocker
    -> [UnificationFailure] -> ExceptT TCErr tcm (LHSState a)
    stuck (Blocker -> Maybe Blocker
    forall a. a -> Maybe a
    Just Blocker
    block) []

            -- Unclear situation.  Try next split.
            UnifyStuck [UnificationFailure]
    errs -> Maybe Blocker
    -> [UnificationFailure] -> ExceptT TCErr tcm (LHSState a)
    stuck Maybe Blocker
    forall a. Maybe a
    Nothing [UnificationFailure]
    errs

            -- Success.
            Unifies (Tele (Dom' Term Type)
    delta1',Substitution' DeBruijnPattern
    rho0,[NamedArg DeBruijnPattern]
    es) -> do

              [Char] -> Int -> TCMT IO Doc -> ExceptT TCErr tcm ()
    forall (m :: * -> *).
    MonadDebug m =>
    [Char] -> Int -> TCMT IO Doc -> m ()
    reportSDoc [Char]
    "tc.lhs.top" Int
    15 (TCMT IO Doc -> ExceptT TCErr tcm ())
    -> TCMT IO Doc -> ExceptT TCErr tcm ()
    forall a b. (a -> b) -> a -> b
    $ TCMT IO Doc
    "unification successful"
              [Char] -> Int -> TCMT IO Doc -> ExceptT TCErr tcm ()
    forall (m :: * -> *).
    MonadDebug m =>
    [Char] -> Int -> TCMT IO Doc -> m ()
    reportSDoc [Char]
    "tc.lhs.top" Int
    20 (TCMT IO Doc -> ExceptT TCErr tcm ())
    -> TCMT IO Doc -> ExceptT TCErr tcm ()
    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
    "delta1' =" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> Tele (Dom' Term Type) -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM Tele (Dom' Term Type)
    delta1'
                , TCMT IO Doc
    "rho0    =" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> Tele (Dom' Term Type) -> TCMT IO Doc -> TCMT IO Doc
    forall b (m :: * -> *) a.
    (AddContext b, MonadAddContext m) =>
    b -> m a -> m a
    addContext Tele (Dom' Term Type)
    delta1' (Substitution' DeBruijnPattern -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM Substitution' DeBruijnPattern
    rho0)
                , TCMT IO Doc
    "es      =" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> Tele (Dom' Term Type) -> TCMT IO Doc -> TCMT IO Doc
    forall b (m :: * -> *) a.
    (AddContext b, MonadAddContext m) =>
    b -> m a -> m a
    addContext Tele (Dom' Term Type)
    delta1' ([Arg (Named NamedName Term)] -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM ([Arg (Named NamedName Term)] -> TCMT IO Doc)
    -> [Arg (Named NamedName Term)] -> TCMT IO Doc
    forall a b. (a -> b) -> a -> b
    $ ((NamedArg DeBruijnPattern -> Arg (Named NamedName Term))
    -> [NamedArg DeBruijnPattern] -> [Arg (Named NamedName Term)]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((NamedArg DeBruijnPattern -> Arg (Named NamedName Term))
     -> [NamedArg DeBruijnPattern] -> [Arg (Named NamedName Term)])
    -> ((DeBruijnPattern -> Term)
        -> NamedArg DeBruijnPattern -> Arg (Named NamedName Term))
    -> (DeBruijnPattern -> Term)
    -> [NamedArg DeBruijnPattern]
    -> [Arg (Named NamedName Term)]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Named NamedName DeBruijnPattern -> Named NamedName Term)
    -> NamedArg DeBruijnPattern -> Arg (Named NamedName Term)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((Named NamedName DeBruijnPattern -> Named NamedName Term)
     -> NamedArg DeBruijnPattern -> Arg (Named NamedName Term))
    -> ((DeBruijnPattern -> Term)
        -> Named NamedName DeBruijnPattern -> Named NamedName Term)
    -> (DeBruijnPattern -> Term)
    -> NamedArg DeBruijnPattern
    -> Arg (Named NamedName Term)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (DeBruijnPattern -> Term)
    -> Named NamedName DeBruijnPattern -> Named NamedName Term
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap) DeBruijnPattern -> Term
    patternToTerm [NamedArg DeBruijnPattern]
    es)
                ]

              -- split substitution into part for Δ₁ and part for Γ
              let (Substitution' DeBruijnPattern
    rho1,Substitution' DeBruijnPattern
    rho2) = Int
    -> Substitution' DeBruijnPattern
    -> (Substitution' DeBruijnPattern, Substitution' DeBruijnPattern)
    forall a.
    Int -> Substitution' a -> (Substitution' a, Substitution' a)
    splitS (Tele (Dom' Term Type) -> Int
    forall a. Sized a => a -> Int
    size Tele (Dom' Term Type)
    gamma) Substitution' DeBruijnPattern
    rho0

              [Char] -> Int -> TCMT IO Doc -> ExceptT TCErr tcm ()
    forall (m :: * -> *).
    MonadDebug m =>
    [Char] -> Int -> TCMT IO Doc -> m ()
    reportSDoc [Char]
    "tc.lhs.top" Int
    20 (TCMT IO Doc -> ExceptT TCErr tcm ())
    -> TCMT IO Doc -> ExceptT TCErr tcm ()
    forall a b. (a -> b) -> a -> b
    $ Tele (Dom' Term Type) -> TCMT IO Doc -> TCMT IO Doc
    forall b (m :: * -> *) a.
    (AddContext b, MonadAddContext m) =>
    b -> m a -> m a
    addContext Tele (Dom' Term Type)
    delta1' (TCMT IO Doc -> TCMT IO Doc) -> TCMT IO Doc -> TCMT IO Doc
    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
    "rho1    =" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> Substitution' DeBruijnPattern -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM Substitution' DeBruijnPattern
    rho1
                , TCMT IO Doc
    "rho2    =" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> Substitution' DeBruijnPattern -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM Substitution' DeBruijnPattern
    rho2
                ]

              -- Andreas, 2010-09-09, save the type.
              -- It is relative to Δ₁, but it should be relative to Δ₁'
              let a' :: Type
    a' = Substitution' DeBruijnPattern -> Type -> Type
    forall a. TermSubst a => Substitution' DeBruijnPattern -> a -> a
    applyPatSubst Substitution' DeBruijnPattern
    rho1 Type
    a

              -- Also remember if we are a record pattern.
              let cpi :: ConPatternInfo
    cpi = ConPatternInfo :: PatternInfo
    -> Bool -> Bool -> Maybe (Arg Type) -> Bool -> ConPatternInfo
    ConPatternInfo { conPInfo :: PatternInfo
    conPInfo   = PatOrigin -> [Name] -> PatternInfo
    PatternInfo PatOrigin
    PatOCon []
                                       , conPRecord :: Bool
    conPRecord = Bool
    isRec
                                       , conPFallThrough :: Bool
    conPFallThrough = Bool
    False
                                       , conPType :: Maybe (Arg Type)
    conPType   = Arg Type -> Maybe (Arg Type)
    forall a. a -> Maybe a
    Just (Arg Type -> Maybe (Arg Type)) -> Arg Type -> Maybe (Arg Type)
    forall a b. (a -> b) -> a -> b
    $ ArgInfo -> Type -> Arg Type
    forall e. ArgInfo -> e -> Arg e
    Arg ArgInfo
    info Type
    a'
                                       , conPLazy :: Bool
    conPLazy   = Bool
    False } -- Don't mark eta-record matches as lazy (#4254)

              -- compute final context and substitution
              let crho :: DeBruijnPattern
    crho    = ConHead
    -> ConPatternInfo -> [NamedArg DeBruijnPattern] -> DeBruijnPattern
    forall x.
    ConHead -> ConPatternInfo -> [NamedArg (Pattern' x)] -> Pattern' x
    ConP ConHead
    c ConPatternInfo
    cpi ([NamedArg DeBruijnPattern] -> DeBruijnPattern)
    -> [NamedArg DeBruijnPattern] -> DeBruijnPattern
    forall a b. (a -> b) -> a -> b
    $ Substitution' (SubstArg [NamedArg DeBruijnPattern])
    -> [NamedArg DeBruijnPattern] -> [NamedArg DeBruijnPattern]
    forall a. Subst a => Substitution' (SubstArg a) -> a -> a
    applySubst Substitution' DeBruijnPattern
    Substitution' (SubstArg [NamedArg DeBruijnPattern])
    rho0 ([NamedArg DeBruijnPattern] -> [NamedArg DeBruijnPattern])
    -> [NamedArg DeBruijnPattern] -> [NamedArg DeBruijnPattern]
    forall a b. (a -> b) -> a -> b
    $ (Tele (Dom' Term Type) -> Boundary -> [NamedArg DeBruijnPattern]
    forall a.
    DeBruijn a =>
    Tele (Dom' Term Type) -> Boundary -> [NamedArg (Pattern' a)]
    telePatterns Tele (Dom' Term Type)
    gamma Boundary
    boundary)
                  rho3 :: Substitution' DeBruijnPattern
    rho3    = DeBruijnPattern
    -> Substitution' DeBruijnPattern -> Substitution' DeBruijnPattern
    forall a. DeBruijn a => a -> Substitution' a -> Substitution' a
    consS DeBruijnPattern
    crho Substitution' DeBruijnPattern
    rho1
                  delta2' :: Tele (Dom' Term Type)
    delta2' = Substitution' DeBruijnPattern
    -> Tele (Dom' Term Type) -> Tele (Dom' Term Type)
    forall a. TermSubst a => Substitution' DeBruijnPattern -> a -> a
    applyPatSubst Substitution' DeBruijnPattern
    rho3 Tele (Dom' Term Type)
    delta2
                  delta' :: Tele (Dom' Term Type)
    delta'  = Tele (Dom' Term Type)
    delta1' Tele (Dom' Term Type)
    -> Tele (Dom' Term Type) -> Tele (Dom' Term Type)
    forall t. Abstract t => Tele (Dom' Term Type) -> t -> t
    `abstract` Tele (Dom' Term Type)
    delta2'
                  rho :: Substitution' DeBruijnPattern
    rho     = Int
    -> Substitution' DeBruijnPattern -> Substitution' DeBruijnPattern
    forall a. Int -> Substitution' a -> Substitution' a
    liftS (Tele (Dom' Term Type) -> Int
    forall a. Sized a => a -> Int
    size Tele (Dom' Term Type)
    delta2) Substitution' DeBruijnPattern
    rho3

              [Char] -> Int -> TCMT IO Doc -> ExceptT TCErr tcm ()
    forall (m :: * -> *).
    MonadDebug m =>
    [Char] -> Int -> TCMT IO Doc -> m ()
    reportSDoc [Char]
    "tc.lhs.top" Int
    20 (TCMT IO Doc -> ExceptT TCErr tcm ())
    -> TCMT IO Doc -> ExceptT TCErr tcm ()
    forall a b. (a -> b) -> a -> b
    $ Tele (Dom' Term Type) -> TCMT IO Doc -> TCMT IO Doc
    forall b (m :: * -> *) a.
    (AddContext b, MonadAddContext m) =>
    b -> m a -> m a
    addContext Tele (Dom' Term Type)
    delta1' (TCMT IO Doc -> TCMT IO Doc) -> TCMT IO Doc -> TCMT IO Doc
    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
    "crho    =" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> DeBruijnPattern -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM DeBruijnPattern
    crho
                , TCMT IO Doc
    "rho3    =" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> Substitution' DeBruijnPattern -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM Substitution' DeBruijnPattern
    rho3
                , TCMT IO Doc
    "delta2' =" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> Tele (Dom' Term Type) -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM Tele (Dom' Term Type)
    delta2'
                ]
              [Char] -> Int -> TCMT IO Doc -> ExceptT TCErr tcm ()
    forall (m :: * -> *).
    MonadDebug m =>
    [Char] -> Int -> TCMT IO Doc -> m ()
    reportSDoc [Char]
    "tc.lhs.top" Int
    70 (TCMT IO Doc -> ExceptT TCErr tcm ())
    -> TCMT IO Doc -> ExceptT TCErr tcm ()
    forall a b. (a -> b) -> a -> b
    $ Tele (Dom' Term Type) -> TCMT IO Doc -> TCMT IO Doc
    forall b (m :: * -> *) a.
    (AddContext b, MonadAddContext m) =>
    b -> m a -> m a
    addContext Tele (Dom' Term Type)
    delta1' (TCMT IO Doc -> TCMT IO Doc) -> TCMT IO Doc -> TCMT IO Doc
    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
    "crho    =" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> DeBruijnPattern -> TCMT IO Doc
    forall (m :: * -> *) a. (Applicative m, Pretty a) => a -> m Doc
    pretty DeBruijnPattern
    crho
                , TCMT IO Doc
    "rho3    =" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> Substitution' DeBruijnPattern -> TCMT IO Doc
    forall (m :: * -> *) a. (Applicative m, Pretty a) => a -> m Doc
    pretty Substitution' DeBruijnPattern
    rho3
                , TCMT IO Doc
    "delta2' =" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> Tele (Dom' Term Type) -> TCMT IO Doc
    forall (m :: * -> *) a. (Applicative m, Pretty a) => a -> m Doc
    pretty Tele (Dom' Term Type)
    delta2'
                ]

              [Char] -> Int -> TCMT IO Doc -> ExceptT TCErr tcm ()
    forall (m :: * -> *).
    MonadDebug m =>
    [Char] -> Int -> TCMT IO Doc -> m ()
    reportSDoc [Char]
    "tc.lhs.top" Int
    15 (TCMT IO Doc -> ExceptT TCErr tcm ())
    -> TCMT IO Doc -> ExceptT TCErr tcm ()
    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
    "delta'  =" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> Tele (Dom' Term Type) -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM Tele (Dom' Term Type)
    delta'
                , TCMT IO Doc
    "rho     =" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> Tele (Dom' Term Type) -> TCMT IO Doc -> TCMT IO Doc
    forall b (m :: * -> *) a.
    (AddContext b, MonadAddContext m) =>
    b -> m a -> m a
    addContext Tele (Dom' Term Type)
    delta' (Substitution' DeBruijnPattern -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM Substitution' DeBruijnPattern
    rho)
                ]

              -- Compute the new out patterns and target type.
              let ip' :: [NamedArg DeBruijnPattern]
    ip'      = Substitution' (SubstArg [NamedArg DeBruijnPattern])
    -> [NamedArg DeBruijnPattern] -> [NamedArg DeBruijnPattern]
    forall a. Subst a => Substitution' (SubstArg a) -> a -> a
    applySubst Substitution' DeBruijnPattern
    Substitution' (SubstArg [NamedArg DeBruijnPattern])
    rho [NamedArg DeBruijnPattern]
    ip
                  target' :: Arg Type
    target'  = Substitution' DeBruijnPattern -> Arg Type -> Arg Type
    forall a. TermSubst a => Substitution' DeBruijnPattern -> a -> a
    applyPatSubst Substitution' DeBruijnPattern
    rho Arg Type
    target

              -- Update the problem equations
              let eqs' :: [ProblemEq]
    eqs' = Substitution' DeBruijnPattern -> [ProblemEq] -> [ProblemEq]
    forall a. TermSubst a => Substitution' DeBruijnPattern -> a -> a
    applyPatSubst Substitution' DeBruijnPattern
    rho ([ProblemEq] -> [ProblemEq]) -> [ProblemEq] -> [ProblemEq]
    forall a b. (a -> b) -> a -> b
    $ Problem a
    problem Problem a -> Lens' [ProblemEq] (Problem a) -> [ProblemEq]
    forall o i. o -> Lens' i o -> i
    ^. forall a. Lens' [ProblemEq] (Problem a)
    Lens' [ProblemEq] (Problem a)
    problemEqs
                  problem' :: Problem a
    problem' = Lens' [ProblemEq] (Problem a) -> LensSet [ProblemEq] (Problem a)
    forall i o. Lens' i o -> LensSet i o
    set forall a. Lens' [ProblemEq] (Problem a)
    Lens' [ProblemEq] (Problem a)
    problemEqs [ProblemEq]
    eqs' Problem a
    problem

              -- The result type's quantity is set to 0 for erased
              -- constructors, but not if the match is made in an erased
              -- position, or if the original constructor definition is
              -- not erased.
              Quantity
    cq <- Definition -> Quantity
    forall a. LensQuantity a => a -> Quantity
    getQuantity (Definition -> Quantity)
    -> ExceptT TCErr tcm Definition -> ExceptT TCErr tcm Quantity
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> QName -> ExceptT TCErr tcm Definition
    forall (m :: * -> *).
    (ReadTCState m, HasConstInfo m) =>
    QName -> m Definition
    getOriginalConstInfo (ConHead -> QName
    conName ConHead
    c)
              let target'' :: Arg Type
    target'' = (Quantity -> Quantity) -> Arg Type -> Arg Type
    forall a. LensQuantity a => (Quantity -> Quantity) -> a -> a
    mapQuantity Quantity -> Quantity
    updResMod Arg Type
    target'
                    where
                      erased :: Bool
    erased = case ArgInfo -> Quantity
    forall a. LensQuantity a => a -> Quantity
    getQuantity ArgInfo
    info of
                        Quantity0{} -> Bool
    True
                        Quantity1{} -> Bool
    forall a. HasCallStack => a
    __IMPOSSIBLE__
                        Quantityω{} -> Bool
    False
                      -- either sets to Quantity0 or is the identity.
                      updResMod :: Quantity -> Quantity
    updResMod Quantity
    q =
                        case Quantity
    cq of
                         Quantity
    _ | Bool
    erased  -> Quantity
    q
                         Quantity0{} -> Quantity -> Quantity -> Quantity
    composeQuantity Quantity
    cq Quantity
    q
                                     -- zero-out, preserves origin
                         Quantity1{} -> Quantity
    forall a. HasCallStack => a
    __IMPOSSIBLE__
                         Quantityω{} -> Quantity
    q

              -- if rest type reduces,
              -- extend the split problem by previously not considered patterns
              LHSState a
    st' <- TCM (LHSState a) -> ExceptT TCErr tcm (LHSState a)
    forall (tcm :: * -> *) a. MonadTCM tcm => TCM a -> tcm a
    liftTCM (TCM (LHSState a) -> ExceptT TCErr tcm (LHSState a))
    -> TCM (LHSState a) -> ExceptT TCErr tcm (LHSState a)
    forall a b. (a -> b) -> a -> b
    $ LHSState a -> TCM (LHSState a)
    forall a. LHSState a -> TCM (LHSState a)
    updateLHSState (LHSState a -> TCM (LHSState a)) -> LHSState a -> TCM (LHSState a)
    forall a b. (a -> b) -> a -> b
    $ Tele (Dom' Term Type)
    -> [NamedArg DeBruijnPattern]
    -> Problem a
    -> Arg Type
    -> [Maybe Int]
    -> LHSState a
    forall a.
    Tele (Dom' Term Type)
    -> [NamedArg DeBruijnPattern]
    -> Problem a
    -> Arg Type
    -> [Maybe Int]
    -> LHSState a
    LHSState Tele (Dom' Term Type)
    delta' [NamedArg DeBruijnPattern]
    ip' Problem a
    problem' Arg Type
    target'' [Maybe Int]
    psplit

              [Char] -> Int -> TCMT IO Doc -> ExceptT TCErr tcm ()
    forall (m :: * -> *).
    MonadDebug m =>
    [Char] -> Int -> TCMT IO Doc -> m ()
    reportSDoc [Char]
    "tc.lhs.top" Int
    12 (TCMT IO Doc -> ExceptT TCErr tcm ())
    -> TCMT IO Doc -> ExceptT TCErr tcm ()
    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
    "new problem from rest"
                , 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
    "delta'  =" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> Tele (Dom' Term Type) -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM (LHSState a
    st' LHSState a
    -> Lens' (Tele (Dom' Term Type)) (LHSState a)
    -> Tele (Dom' Term Type)
    forall o i. o -> Lens' i o -> i
    ^. forall a. Lens' (Tele (Dom' Term Type)) (LHSState a)
    Lens' (Tele (Dom' Term Type)) (LHSState a)
    lhsTel)
                  , TCMT IO Doc
    "eqs'    =" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> Tele (Dom' Term Type) -> TCMT IO Doc -> TCMT IO Doc
    forall b (m :: * -> *) a.
    (AddContext b, MonadAddContext m) =>
    b -> m a -> m a
    addContext (LHSState a
    st' LHSState a
    -> Lens' (Tele (Dom' Term Type)) (LHSState a)
    -> Tele (Dom' Term Type)
    forall o i. o -> Lens' i o -> i
    ^. forall a. Lens' (Tele (Dom' Term Type)) (LHSState a)
    Lens' (Tele (Dom' Term Type)) (LHSState a)
    lhsTel) ([ProblemEq] -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM ([ProblemEq] -> TCMT IO Doc) -> [ProblemEq] -> TCMT IO Doc
    forall a b. (a -> b) -> a -> b
    $ LHSState a
    st' LHSState a -> Lens' [ProblemEq] (LHSState a) -> [ProblemEq]
    forall o i. o -> Lens' i o -> i
    ^. ((Problem a -> f (Problem a)) -> LHSState a -> f (LHSState a)
    forall a. Lens' (Problem a) (LHSState a)
    lhsProblem ((Problem a -> f (Problem a)) -> LHSState a -> f (LHSState a))
    -> (([ProblemEq] -> f [ProblemEq]) -> Problem a -> f (Problem a))
    -> ([ProblemEq] -> f [ProblemEq])
    -> LHSState a
    -> f (LHSState a)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ([ProblemEq] -> f [ProblemEq]) -> Problem a -> f (Problem a)
    forall a. Lens' [ProblemEq] (Problem a)
    problemEqs))
                  , TCMT IO Doc
    "ip'     =" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> Tele (Dom' Term Type) -> TCMT IO Doc -> TCMT IO Doc
    forall b (m :: * -> *) a.
    (AddContext b, MonadAddContext m) =>
    b -> m a -> m a
    addContext (LHSState a
    st' LHSState a
    -> Lens' (Tele (Dom' Term Type)) (LHSState a)
    -> Tele (Dom' Term Type)
    forall o i. o -> Lens' i o -> i
    ^. forall a. Lens' (Tele (Dom' Term Type)) (LHSState a)
    Lens' (Tele (Dom' Term Type)) (LHSState a)
    lhsTel) ([NamedArg DeBruijnPattern] -> TCMT IO Doc
    forall (m :: * -> *) a. (Applicative m, Pretty a) => a -> m Doc
    pretty ([NamedArg DeBruijnPattern] -> TCMT IO Doc)
    -> [NamedArg DeBruijnPattern] -> TCMT IO Doc
    forall a b. (a -> b) -> a -> b
    $ LHSState a
    st' LHSState a
    -> Lens' [NamedArg DeBruijnPattern] (LHSState a)
    -> [NamedArg DeBruijnPattern]
    forall o i. o -> Lens' i o -> i
    ^. forall a. Lens' [NamedArg DeBruijnPattern] (LHSState a)
    Lens' [NamedArg DeBruijnPattern] (LHSState a)
    lhsOutPat)
                  ]
                ]
              LHSState a -> ExceptT TCErr tcm (LHSState a)
    forall (m :: * -> *) a. Monad m => a -> m a
    return LHSState a
    st'

    -- | Ensures that we are not performing pattern matching on coinductive constructors.

    checkMatchingAllowed :: (MonadTCError m)
      => QName         -- ^ The name of the data or record type the constructor belongs to.
      -> DataOrRecord  -- ^ Information about data or (co)inductive (no-)eta-equality record.
      -> m ()
    checkMatchingAllowed :: forall (m :: * -> *).
    MonadTCError m =>
    QName -> DataOrRecord -> m ()
    checkMatchingAllowed QName
    d = \case
      IsRecord Maybe Induction
    ind EtaEquality
    eta
        | Just Induction
    CoInductive <- Maybe Induction
    ind -> TypeError -> m ()
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCError m) =>
    TypeError -> m a
    typeError (TypeError -> m ()) -> TypeError -> m ()
    forall a b. (a -> b) -> a -> b
    $
            [Char] -> TypeError
    GenericError [Char]
    "Pattern matching on coinductive types is not allowed"
        | Bool -> Bool
    not (Bool -> Bool) -> Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $ EtaEquality -> Bool
    forall a. PatternMatchingAllowed a => a -> Bool
    patternMatchingAllowed EtaEquality
    eta -> TypeError -> m ()
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCError m) =>
    TypeError -> m a
    typeError (TypeError -> m ()) -> TypeError -> m ()
    forall a b. (a -> b) -> a -> b
    $ QName -> TypeError
    SplitOnNonEtaRecord QName
    d
        | Bool
    otherwise -> () -> m ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
      DataOrRecord
    IsData -> () -> m ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

    -- | When working with a monad @m@ implementing @MonadTCM@ and @MonadError TCErr@,
    --   @suspendErrors f@ performs the TCM action @f@ but catches any errors and throws
    --   them in the monad @m@ instead.
    suspendErrors :: (MonadTCM m, MonadError TCErr m) => TCM a -> m a
    suspendErrors :: forall (m :: * -> *) a.
    (MonadTCM m, MonadError TCErr m) =>
    TCM a -> m a
    suspendErrors TCM a
    f = do
      Either TCErr a
    ok <- TCM (Either TCErr a) -> m (Either TCErr a)
    forall (tcm :: * -> *) a. MonadTCM tcm => TCM a -> tcm a
    liftTCM (TCM (Either TCErr a) -> m (Either TCErr a))
    -> TCM (Either TCErr a) -> m (Either TCErr a)
    forall a b. (a -> b) -> a -> b
    $ (a -> Either TCErr a
    forall a b. b -> Either a b
    Right (a -> Either TCErr a) -> TCM a -> TCM (Either TCErr a)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> TCM a
    f) TCM (Either TCErr a)
    -> (TCErr -> TCM (Either TCErr a)) -> TCM (Either TCErr a)
    forall e (m :: * -> *) a.
    MonadError e m =>
    m a -> (e -> m a) -> m a
    `catchError` (Either TCErr a -> TCM (Either TCErr a)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Either TCErr a -> TCM (Either TCErr a))
    -> (TCErr -> Either TCErr a) -> TCErr -> TCM (Either TCErr a)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . TCErr -> Either TCErr a
    forall a b. a -> Either a b
    Left)
      (TCErr -> m a) -> (a -> m a) -> Either TCErr a -> m a
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either TCErr -> m a
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Either TCErr a
    ok

    -- | A more direct implementation of the specification
    --   @softTypeError err == suspendErrors (typeError err)@
    softTypeError :: (HasCallStack, ReadTCState m, MonadError TCErr m, MonadTCEnv m) => TypeError -> m a
    softTypeError :: forall (m :: * -> *) a.
    (HasCallStack, ReadTCState m, MonadError TCErr m, MonadTCEnv m) =>
    TypeError -> m a
    softTypeError TypeError
    err = (CallStack -> m a) -> m a
    forall b. HasCallStack => (CallStack -> b) -> b
    withCallerCallStack ((CallStack -> m a) -> m a) -> (CallStack -> m a) -> m a
    forall a b. (a -> b) -> a -> b
    $ \CallStack
    loc ->
      TCErr -> m a
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError (TCErr -> m a) -> m TCErr -> m a
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< CallStack -> TypeError -> m TCErr
    forall (m :: * -> *) a.
    MonadTCError m =>
    CallStack -> TypeError -> m a
    typeError' CallStack
    loc TypeError
    err

    -- | A convenient alias for @liftTCM . typeError@. Throws the error directly
    --   in the TCM even if there is a surrounding monad also implementing
    --   @MonadError TCErr@.
    hardTypeError :: (HasCallStack, MonadTCM m) => TypeError -> m a
    hardTypeError :: forall (m :: * -> *) a.
    (HasCallStack, MonadTCM m) =>
    TypeError -> m a
    hardTypeError = (CallStack -> TypeError -> m a) -> TypeError -> m a
    forall b. HasCallStack => (CallStack -> b) -> b
    withCallerCallStack ((CallStack -> TypeError -> m a) -> TypeError -> m a)
    -> (CallStack -> TypeError -> m a) -> TypeError -> m a
    forall a b. (a -> b) -> a -> b
    $ \CallStack
    loc -> TCM a -> m a
    forall (tcm :: * -> *) a. MonadTCM tcm => TCM a -> tcm a
    liftTCM (TCM a -> m a) -> (TypeError -> TCM a) -> TypeError -> m a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . CallStack -> TypeError -> TCM a
    forall (m :: * -> *) a.
    MonadTCError m =>
    CallStack -> TypeError -> m a
    typeError' CallStack
    loc

    data DataOrRecord
      = IsData
      | IsRecord
        { DataOrRecord -> Maybe Induction
    recordInduction   :: Maybe Induction
        , DataOrRecord -> EtaEquality
    recordEtaEquality :: EtaEquality
        }
      deriving (Int -> DataOrRecord -> [Char] -> [Char]
    [DataOrRecord] -> [Char] -> [Char]
    DataOrRecord -> [Char]
    (Int -> DataOrRecord -> [Char] -> [Char])
    -> (DataOrRecord -> [Char])
    -> ([DataOrRecord] -> [Char] -> [Char])
    -> Show DataOrRecord
    forall a.
    (Int -> a -> [Char] -> [Char])
    -> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
    showList :: [DataOrRecord] -> [Char] -> [Char]
    $cshowList :: [DataOrRecord] -> [Char] -> [Char]
    show :: DataOrRecord -> [Char]
    $cshow :: DataOrRecord -> [Char]
    showsPrec :: Int -> DataOrRecord -> [Char] -> [Char]
    $cshowsPrec :: Int -> DataOrRecord -> [Char] -> [Char]
    Show)

    -- | Check if the type is a data or record type and return its name,
    --   definition, parameters, and indices. Fails softly if the type could become
    --   a data/record type by instantiating a variable/metavariable, or fail hard
    --   otherwise.
    isDataOrRecordType
      :: (MonadTCM m, PureTCM m)
      => Type
      -> ExceptT TCErr m (DataOrRecord, QName, Args, Args)
           -- ^ The 'Args' are parameters and indices.

    isDataOrRecordType :: forall (m :: * -> *).
    (MonadTCM m, PureTCM m) =>
    Type -> ExceptT TCErr m (DataOrRecord, QName, Args, Args)
    isDataOrRecordType Type
    a0 = Type
    -> (Blocker
        -> Type -> ExceptT TCErr m (DataOrRecord, QName, Args, Args))
    -> (NotBlocked
        -> Type -> ExceptT TCErr m (DataOrRecord, QName, Args, Args))
    -> ExceptT TCErr m (DataOrRecord, QName, Args, Args)
    forall t (m :: * -> *) a.
    (Reduce t, IsMeta t, MonadReduce m) =>
    t -> (Blocker -> t -> m a) -> (NotBlocked -> t -> m a) -> m a
    ifBlocked Type
    a0 Blocker
    -> Type -> ExceptT TCErr m (DataOrRecord, QName, Args, Args)
    blocked ((NotBlocked
      -> Type -> ExceptT TCErr m (DataOrRecord, QName, Args, Args))
     -> ExceptT TCErr m (DataOrRecord, QName, Args, Args))
    -> (NotBlocked
        -> Type -> ExceptT TCErr m (DataOrRecord, QName, Args, Args))
    -> ExceptT TCErr m (DataOrRecord, QName, Args, Args)
    forall a b. (a -> b) -> a -> b
    $ \case
      NotBlocked
    ReallyNotBlocked -> \ Type
    a -> case Type -> Term
    forall t a. Type'' t a -> a
    unEl Type
    a of

        -- Subcase: split type is a Def.
        Def QName
    d Elims
    es -> TCMT IO Defn -> ExceptT TCErr m Defn
    forall (tcm :: * -> *) a. MonadTCM tcm => TCM a -> tcm a
    liftTCM (Definition -> Defn
    theDef (Definition -> Defn) -> TCMT IO Definition -> TCMT IO Defn
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> QName -> TCMT IO Definition
    forall (m :: * -> *). HasConstInfo m => QName -> m Definition
    getConstInfo QName
    d) ExceptT TCErr m Defn
    -> (Defn -> ExceptT TCErr m (DataOrRecord, QName, Args, Args))
    -> ExceptT TCErr m (DataOrRecord, QName, Args, Args)
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \case

          Datatype{dataPars :: Defn -> Int
    dataPars = Int
    np} -> do

            ExceptT TCErr m Bool -> ExceptT TCErr m () -> ExceptT TCErr m ()
    forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
    whenM (Type -> ExceptT TCErr m Bool
    forall (m :: * -> *). (MonadTCM m, MonadReduce m) => Type -> m Bool
    isInterval Type
    a) (ExceptT TCErr m () -> ExceptT TCErr m ())
    -> ExceptT TCErr m () -> ExceptT TCErr m ()
    forall a b. (a -> b) -> a -> b
    $ TypeError -> ExceptT TCErr m ()
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCM m) =>
    TypeError -> m a
    hardTypeError (TypeError -> ExceptT TCErr m ())
    -> ExceptT TCErr m TypeError -> ExceptT TCErr m ()
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< ExceptT TCErr m TypeError
    notData

            let (Args
    pars, Args
    ixs) = Int -> Args -> (Args, Args)
    forall a. Int -> [a] -> ([a], [a])
    splitAt Int
    np (Args -> (Args, Args)) -> Args -> (Args, Args)
    forall a b. (a -> b) -> a -> b
    $ Args -> Maybe Args -> Args
    forall a. a -> Maybe a -> a
    fromMaybe Args
    forall a. HasCallStack => a
    __IMPOSSIBLE__ (Maybe Args -> Args) -> Maybe Args -> Args
    forall a b. (a -> b) -> a -> b
    $ Elims -> Maybe Args
    forall a. [Elim' a] -> Maybe [Arg a]
    allApplyElims Elims
    es
            (DataOrRecord, QName, Args, Args)
    -> ExceptT TCErr m (DataOrRecord, QName, Args, Args)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (DataOrRecord
    IsData, QName
    d, Args
    pars, Args
    ixs)

          Record{ Maybe Induction
    recInduction :: Defn -> Maybe Induction
    recInduction :: Maybe Induction
    recInduction, EtaEquality
    recEtaEquality' :: Defn -> EtaEquality
    recEtaEquality' :: EtaEquality
    recEtaEquality' } -> do
            let pars :: Args
    pars = Args -> Maybe Args -> Args
    forall a. a -> Maybe a -> a
    fromMaybe Args
    forall a. HasCallStack => a
    __IMPOSSIBLE__ (Maybe Args -> Args) -> Maybe Args -> Args
    forall a b. (a -> b) -> a -> b
    $ Elims -> Maybe Args
    forall a. [Elim' a] -> Maybe [Arg a]
    allApplyElims Elims
    es
            (DataOrRecord, QName, Args, Args)
    -> ExceptT TCErr m (DataOrRecord, QName, Args, Args)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe Induction -> EtaEquality -> DataOrRecord
    IsRecord Maybe Induction
    recInduction EtaEquality
    recEtaEquality', QName
    d, Args
    pars, [])

          -- Issue #2253: the data type could be abstract.
          AbstractDefn{} -> TypeError -> ExceptT TCErr m (DataOrRecord, QName, Args, Args)
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCM m) =>
    TypeError -> m a
    hardTypeError (TypeError -> ExceptT TCErr m (DataOrRecord, QName, Args, Args))
    -> (Doc -> TypeError)
    -> Doc
    -> ExceptT TCErr m (DataOrRecord, QName, Args, Args)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Doc -> TypeError
    GenericDocError (Doc -> ExceptT TCErr m (DataOrRecord, QName, Args, Args))
    -> ExceptT TCErr m Doc
    -> ExceptT TCErr m (DataOrRecord, QName, Args, Args)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< do
            TCMT IO Doc -> ExceptT TCErr m Doc
    forall (tcm :: * -> *) a. MonadTCM tcm => TCM a -> tcm a
    liftTCM (TCMT IO Doc -> ExceptT TCErr m Doc)
    -> TCMT IO Doc -> ExceptT TCErr m Doc
    forall a b. (a -> b) -> a -> b
    $ TCMT IO Doc
    "Cannot split on abstract data type" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> QName -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM QName
    d

          -- the type could be an axiom
          Axiom{} -> TypeError -> ExceptT TCErr m (DataOrRecord, QName, Args, Args)
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCM m) =>
    TypeError -> m a
    hardTypeError (TypeError -> ExceptT TCErr m (DataOrRecord, QName, Args, Args))
    -> ExceptT TCErr m TypeError
    -> ExceptT TCErr m (DataOrRecord, QName, Args, Args)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< ExceptT TCErr m TypeError
    notData

          -- Can't match before we have the definition
          DataOrRecSig{} -> TypeError -> ExceptT TCErr m (DataOrRecord, QName, Args, Args)
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCM m) =>
    TypeError -> m a
    hardTypeError (TypeError -> ExceptT TCErr m (DataOrRecord, QName, Args, Args))
    -> (Doc -> TypeError)
    -> Doc
    -> ExceptT TCErr m (DataOrRecord, QName, Args, Args)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Doc -> TypeError
    GenericDocError (Doc -> ExceptT TCErr m (DataOrRecord, QName, Args, Args))
    -> ExceptT TCErr m Doc
    -> ExceptT TCErr m (DataOrRecord, QName, Args, Args)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< do
            TCMT IO Doc -> ExceptT TCErr m Doc
    forall (tcm :: * -> *) a. MonadTCM tcm => TCM a -> tcm a
    liftTCM (TCMT IO Doc -> ExceptT TCErr m Doc)
    -> TCMT IO Doc -> ExceptT TCErr m Doc
    forall a b. (a -> b) -> a -> b
    $ TCMT IO Doc
    "Cannot split on data type" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> QName -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM QName
    d TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> TCMT IO Doc
    "whose definition has not yet been checked"

          -- Issue #2997: the type could be a Def that does not reduce for some reason
          -- (abstract, failed termination checking, NON_TERMINATING, ...)
          Function{}    -> TypeError -> ExceptT TCErr m (DataOrRecord, QName, Args, Args)
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCM m) =>
    TypeError -> m a
    hardTypeError (TypeError -> ExceptT TCErr m (DataOrRecord, QName, Args, Args))
    -> ExceptT TCErr m TypeError
    -> ExceptT TCErr m (DataOrRecord, QName, Args, Args)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< ExceptT TCErr m TypeError
    notData

          Constructor{} -> ExceptT TCErr m (DataOrRecord, QName, Args, Args)
    forall a. HasCallStack => a
    __IMPOSSIBLE__

          -- Issue #3620: Some primitives are types too.
          -- Not data though, at least currently 11/03/2018.
          Primitive{}   -> TypeError -> ExceptT TCErr m (DataOrRecord, QName, Args, Args)
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCM m) =>
    TypeError -> m a
    hardTypeError (TypeError -> ExceptT TCErr m (DataOrRecord, QName, Args, Args))
    -> ExceptT TCErr m TypeError
    -> ExceptT TCErr m (DataOrRecord, QName, Args, Args)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< ExceptT TCErr m TypeError
    notData

          PrimitiveSort{} -> TypeError -> ExceptT TCErr m (DataOrRecord, QName, Args, Args)
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCM m) =>
    TypeError -> m a
    hardTypeError (TypeError -> ExceptT TCErr m (DataOrRecord, QName, Args, Args))
    -> ExceptT TCErr m TypeError
    -> ExceptT TCErr m (DataOrRecord, QName, Args, Args)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< ExceptT TCErr m TypeError
    notData

          GeneralizableVar{} -> ExceptT TCErr m (DataOrRecord, QName, Args, Args)
    forall a. HasCallStack => a
    __IMPOSSIBLE__

        -- variable: fail softly
        Var{}      -> TypeError -> ExceptT TCErr m (DataOrRecord, QName, Args, Args)
    forall (m :: * -> *) a.
    (HasCallStack, ReadTCState m, MonadError TCErr m, MonadTCEnv m) =>
    TypeError -> m a
    softTypeError (TypeError -> ExceptT TCErr m (DataOrRecord, QName, Args, Args))
    -> ExceptT TCErr m TypeError
    -> ExceptT TCErr m (DataOrRecord, QName, Args, Args)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< ExceptT TCErr m TypeError
    notData
        MetaV{}    -> ExceptT TCErr m (DataOrRecord, QName, Args, Args)
    forall a. HasCallStack => a
    __IMPOSSIBLE__  -- That is handled in @blocked@.

        -- pi or sort: fail hard
        Pi{}       -> TypeError -> ExceptT TCErr m (DataOrRecord, QName, Args, Args)
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCM m) =>
    TypeError -> m a
    hardTypeError (TypeError -> ExceptT TCErr m (DataOrRecord, QName, Args, Args))
    -> ExceptT TCErr m TypeError
    -> ExceptT TCErr m (DataOrRecord, QName, Args, Args)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< ExceptT TCErr m TypeError
    notData
        Sort{}     -> TypeError -> ExceptT TCErr m (DataOrRecord, QName, Args, Args)
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCM m) =>
    TypeError -> m a
    hardTypeError (TypeError -> ExceptT TCErr m (DataOrRecord, QName, Args, Args))
    -> ExceptT TCErr m TypeError
    -> ExceptT TCErr m (DataOrRecord, QName, Args, Args)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< ExceptT TCErr m TypeError
    notData

        Lam{}      -> ExceptT TCErr m (DataOrRecord, QName, Args, Args)
    forall a. HasCallStack => a
    __IMPOSSIBLE__
        Lit{}      -> ExceptT TCErr m (DataOrRecord, QName, Args, Args)
    forall a. HasCallStack => a
    __IMPOSSIBLE__
        Con{}      -> ExceptT TCErr m (DataOrRecord, QName, Args, Args)
    forall a. HasCallStack => a
    __IMPOSSIBLE__
        Level{}    -> ExceptT TCErr m (DataOrRecord, QName, Args, Args)
    forall a. HasCallStack => a
    __IMPOSSIBLE__
        DontCare{} -> ExceptT TCErr m (DataOrRecord, QName, Args, Args)
    forall a. HasCallStack => a
    __IMPOSSIBLE__
        Dummy [Char]
    s Elims
    _  -> [Char] -> ExceptT TCErr m (DataOrRecord, QName, Args, Args)
    forall (m :: * -> *) a.
    (HasCallStack, MonadDebug m) =>
    [Char] -> m a
    __IMPOSSIBLE_VERBOSE__ [Char]
    s

      -- neutral type: fail softly
      StuckOn{}     -> \ Type
    _a -> TypeError -> ExceptT TCErr m (DataOrRecord, QName, Args, Args)
    forall (m :: * -> *) a.
    (HasCallStack, ReadTCState m, MonadError TCErr m, MonadTCEnv m) =>
    TypeError -> m a
    softTypeError (TypeError -> ExceptT TCErr m (DataOrRecord, QName, Args, Args))
    -> ExceptT TCErr m TypeError
    -> ExceptT TCErr m (DataOrRecord, QName, Args, Args)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< ExceptT TCErr m TypeError
    notData
      AbsurdMatch{} -> \ Type
    _a -> TypeError -> ExceptT TCErr m (DataOrRecord, QName, Args, Args)
    forall (m :: * -> *) a.
    (HasCallStack, ReadTCState m, MonadError TCErr m, MonadTCEnv m) =>
    TypeError -> m a
    softTypeError (TypeError -> ExceptT TCErr m (DataOrRecord, QName, Args, Args))
    -> ExceptT TCErr m TypeError
    -> ExceptT TCErr m (DataOrRecord, QName, Args, Args)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< ExceptT TCErr m TypeError
    notData

      -- missing clauses: fail hard
      -- TODO: postpone checking of the whole clause until later?
      MissingClauses{} -> \ Type
    _a -> TypeError -> ExceptT TCErr m (DataOrRecord, QName, Args, Args)
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCM m) =>
    TypeError -> m a
    hardTypeError (TypeError -> ExceptT TCErr m (DataOrRecord, QName, Args, Args))
    -> ExceptT TCErr m TypeError
    -> ExceptT TCErr m (DataOrRecord, QName, Args, Args)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< ExceptT TCErr m TypeError
    notData

      -- underapplied type: should not happen
      Underapplied{} -> Type -> ExceptT TCErr m (DataOrRecord, QName, Args, Args)
    forall a. HasCallStack => a
    __IMPOSSIBLE__

      where
      notData :: ExceptT TCErr m TypeError
    notData      = TCM TypeError -> ExceptT TCErr m TypeError
    forall (tcm :: * -> *) a. MonadTCM tcm => TCM a -> tcm a
    liftTCM (TCM TypeError -> ExceptT TCErr m TypeError)
    -> TCM TypeError -> ExceptT TCErr m TypeError
    forall a b. (a -> b) -> a -> b
    $ SplitError -> TypeError
    SplitError (SplitError -> TypeError)
    -> (Closure Type -> SplitError) -> Closure Type -> TypeError
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Closure Type -> SplitError
    NotADatatype (Closure Type -> TypeError)
    -> TCMT IO (Closure Type) -> TCM TypeError
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Type -> TCMT IO (Closure Type)
    forall (m :: * -> *) a.
    (MonadTCEnv m, ReadTCState m) =>
    a -> m (Closure a)
    buildClosure Type
    a0
      blocked :: Blocker
    -> Type -> ExceptT TCErr m (DataOrRecord, QName, Args, Args)
    blocked Blocker
    b Type
    _a = TypeError -> ExceptT TCErr m (DataOrRecord, QName, Args, Args)
    forall (m :: * -> *) a.
    (HasCallStack, ReadTCState m, MonadError TCErr m, MonadTCEnv m) =>
    TypeError -> m a
    softTypeError (TypeError -> ExceptT TCErr m (DataOrRecord, QName, Args, Args))
    -> ExceptT TCErr m TypeError
    -> ExceptT TCErr m (DataOrRecord, QName, Args, Args)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< do TCM TypeError -> ExceptT TCErr m TypeError
    forall (tcm :: * -> *) a. MonadTCM tcm => TCM a -> tcm a
    liftTCM (TCM TypeError -> ExceptT TCErr m TypeError)
    -> TCM TypeError -> ExceptT TCErr m TypeError
    forall a b. (a -> b) -> a -> b
    $ SplitError -> TypeError
    SplitError (SplitError -> TypeError)
    -> (Closure Type -> SplitError) -> Closure Type -> TypeError
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Blocker -> Closure Type -> SplitError
    BlockedType Blocker
    b (Closure Type -> TypeError)
    -> TCMT IO (Closure Type) -> TCM TypeError
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Type -> TCMT IO (Closure Type)
    forall (m :: * -> *) a.
    (MonadTCEnv m, ReadTCState m) =>
    a -> m (Closure a)
    buildClosure Type
    a0

    -- | Get the constructor of the given record type together with its type.
    --   Throws an error if the type is not a record type.
    getRecordConstructor
      :: QName  -- ^ Name @d@ of the record type
      -> Args   -- ^ Parameters @pars@ of the record type
      -> Type   -- ^ The record type @Def d pars@ (for error reporting)
      -> TCM (ConHead, Type)
    getRecordConstructor :: QName -> Args -> Type -> TCM (ConHead, Type)
    getRecordConstructor QName
    d Args
    pars Type
    a = do
      ConHead
    con <- (Definition -> Defn
    theDef (Definition -> Defn) -> TCMT IO Definition -> TCMT IO Defn
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> QName -> TCMT IO Definition
    forall (m :: * -> *). HasConstInfo m => QName -> m Definition
    getConstInfo QName
    d) TCMT IO Defn -> (Defn -> TCMT IO ConHead) -> TCMT IO ConHead
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \case
        Record{recConHead :: Defn -> ConHead
    recConHead = ConHead
    con} -> ConHead -> TCMT IO ConHead
    forall (m :: * -> *) a. Monad m => a -> m a
    return (ConHead -> TCMT IO ConHead) -> ConHead -> TCMT IO ConHead
    forall a b. (a -> b) -> a -> b
    $ KillRangeT ConHead
    forall a. KillRange a => KillRangeT a
    killRange ConHead
    con
        Defn
    _ -> TypeError -> TCMT IO ConHead
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCError m) =>
    TypeError -> m a
    typeError (TypeError -> TCMT IO ConHead) -> TypeError -> TCMT IO ConHead
    forall a b. (a -> b) -> a -> b
    $ Type -> TypeError
    ShouldBeRecordType Type
    a
      Type
    b <- (Type -> Args -> Type
    `piApply` Args
    pars) (Type -> Type) -> (Definition -> Type) -> Definition -> Type
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Definition -> Type
    defType (Definition -> Type) -> TCMT IO Definition -> TCMT IO Type
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> QName -> TCMT IO Definition
    forall (m :: * -> *). HasConstInfo m => QName -> m Definition
    getConstInfo (ConHead -> QName
    conName ConHead
    con)
      (ConHead, Type) -> TCM (ConHead, Type)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (ConHead
    con, Type
    b)

    -- | Disambiguate a projection based on the record type it is supposed to be
    --   projecting from. Returns the unambiguous projection name and its type.
    --   Throws an error if the type is not a record type.
    disambiguateProjection
      :: Maybe Hiding   -- ^ Hiding info of the projection's principal argument.
                        --   @Nothing@ if 'Postfix' projection.
      -> AmbiguousQName -- ^ Name of the projection to be disambiguated.
      -> Arg Type       -- ^ Record type we are projecting from.
      -> TCM (QName, Bool, QName, Arg Type, ArgInfo)
           -- ^ @Bool@ signifies whether copattern matching is allowed at
           --   the inferred record type.
    disambiguateProjection :: Maybe Hiding
    -> AmbiguousQName
    -> Arg Type
    -> TCM (QName, Bool, QName, Arg Type, ArgInfo)
    disambiguateProjection Maybe Hiding
    h ambD :: AmbiguousQName
    ambD@(AmbQ List1 QName
    ds) Arg Type
    b = do
      -- If the target is not a record type, that's an error.
      -- It could be a meta, but since we cannot postpone lhs checking, we crash here.
      TCM (Maybe (QName, Args, Defn))
    -> TCM (QName, Bool, QName, Arg Type, ArgInfo)
    -> ((QName, Args, Defn)
        -> TCM (QName, Bool, QName, Arg Type, ArgInfo))
    -> TCM (QName, Bool, QName, Arg Type, ArgInfo)
    forall (m :: * -> *) a b.
    Monad m =>
    m (Maybe a) -> m b -> (a -> m b) -> m b
    caseMaybeM (TCM (Maybe (QName, Args, Defn)) -> TCM (Maybe (QName, Args, Defn))
    forall (tcm :: * -> *) a. MonadTCM tcm => TCM a -> tcm a
    liftTCM (TCM (Maybe (QName, Args, Defn))
     -> TCM (Maybe (QName, Args, Defn)))
    -> TCM (Maybe (QName, Args, Defn))
    -> TCM (Maybe (QName, Args, Defn))
    forall a b. (a -> b) -> a -> b
    $ Type -> TCM (Maybe (QName, Args, Defn))
    forall (m :: * -> *).
    PureTCM m =>
    Type -> m (Maybe (QName, Args, Defn))
    isRecordType (Type -> TCM (Maybe (QName, Args, Defn)))
    -> Type -> TCM (Maybe (QName, Args, Defn))
    forall a b. (a -> b) -> a -> b
    $ Arg Type -> Type
    forall e. Arg e -> e
    unArg Arg Type
    b) TCM (QName, Bool, QName, Arg Type, ArgInfo)
    notRecord (((QName, Args, Defn)
      -> TCM (QName, Bool, QName, Arg Type, ArgInfo))
     -> TCM (QName, Bool, QName, Arg Type, ArgInfo))
    -> ((QName, Args, Defn)
        -> TCM (QName, Bool, QName, Arg Type, ArgInfo))
    -> TCM (QName, Bool, QName, Arg Type, ArgInfo)
    forall a b. (a -> b) -> a -> b
    $ \(QName
    r, Args
    vs, Defn
    def) -> case Defn
    def of
        Record{ recFields :: Defn -> [Dom' Term QName]
    recFields = [Dom' Term QName]
    fs, Maybe Induction
    recInduction :: Maybe Induction
    recInduction :: Defn -> Maybe Induction
    recInduction, recEtaEquality' :: Defn -> EtaEquality
    recEtaEquality' = EtaEquality
    eta } -> do
          [Char] -> Int -> TCMT IO Doc -> TCMT IO ()
    forall (m :: * -> *).
    MonadDebug m =>
    [Char] -> Int -> TCMT IO Doc -> m ()
    reportSDoc [Char]
    "tc.lhs.split" Int
    20 (TCMT IO Doc -> TCMT IO ()) -> TCMT IO Doc -> TCMT IO ()
    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
            [ [Char] -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => [Char] -> m Doc
    text ([Char] -> TCMT IO Doc) -> [Char] -> TCMT IO Doc
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "we are of record type r  = " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ QName -> [Char]
    forall a. Pretty a => a -> [Char]
    prettyShow QName
    r
            , [Char] -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => [Char] -> m Doc
    text   [Char]
    "applied to parameters vs = " TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> Args -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM Args
    vs
            , [Char] -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => [Char] -> m Doc
    text ([Char] -> TCMT IO Doc) -> [Char] -> TCMT IO Doc
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "and have fields       fs = " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Arg QName] -> [Char]
    forall a. Pretty a => a -> [Char]
    prettyShow ((Dom' Term QName -> Arg QName) -> [Dom' Term QName] -> [Arg QName]
    forall a b. (a -> b) -> [a] -> [b]
    map Dom' Term QName -> Arg QName
    forall t a. Dom' t a -> Arg a
    argFromDom [Dom' Term QName]
    fs)
            ]
          let comatching :: Bool
    comatching = Maybe Induction
    recInduction Maybe Induction -> Maybe Induction -> Bool
    forall a. Eq a => a -> a -> Bool
    == Induction -> Maybe Induction
    forall a. a -> Maybe a
    Just Induction
    CoInductive
                        Bool -> Bool -> Bool
    || EtaEquality -> Bool
    forall a. CopatternMatchingAllowed a => a -> Bool
    copatternMatchingAllowed EtaEquality
    eta
          -- Try the projection candidates.
          -- First, we try to find a disambiguation that doesn't produce
          -- any new constraints.
          Bool
    -> [Dom' Term QName]
    -> QName
    -> Args
    -> Bool
    -> (([TCErr], [(QName, (Arg Type, ArgInfo, Maybe TCState))])
        -> TCM (QName, Bool, QName, Arg Type, ArgInfo))
    -> TCM (QName, Bool, QName, Arg Type, ArgInfo)
    tryDisambiguate Bool
    False [Dom' Term QName]
    fs QName
    r Args
    vs Bool
    comatching ((([TCErr], [(QName, (Arg Type, ArgInfo, Maybe TCState))])
      -> TCM (QName, Bool, QName, Arg Type, ArgInfo))
     -> TCM (QName, Bool, QName, Arg Type, ArgInfo))
    -> (([TCErr], [(QName, (Arg Type, ArgInfo, Maybe TCState))])
        -> TCM (QName, Bool, QName, Arg Type, ArgInfo))
    -> TCM (QName, Bool, QName, Arg Type, ArgInfo)
    forall a b. (a -> b) -> a -> b
    $ \ ([TCErr], [(QName, (Arg Type, ArgInfo, Maybe TCState))])
    _ ->
              -- If this fails, we try again with constraints, but we require
              -- the solution to be unique.
              Bool
    -> [Dom' Term QName]
    -> QName
    -> Args
    -> Bool
    -> (([TCErr], [(QName, (Arg Type, ArgInfo, Maybe TCState))])
        -> TCM (QName, Bool, QName, Arg Type, ArgInfo))
    -> TCM (QName, Bool, QName, Arg Type, ArgInfo)
    tryDisambiguate Bool
    True [Dom' Term QName]
    fs QName
    r Args
    vs Bool
    comatching ((([TCErr], [(QName, (Arg Type, ArgInfo, Maybe TCState))])
      -> TCM (QName, Bool, QName, Arg Type, ArgInfo))
     -> TCM (QName, Bool, QName, Arg Type, ArgInfo))
    -> (([TCErr], [(QName, (Arg Type, ArgInfo, Maybe TCState))])
        -> TCM (QName, Bool, QName, Arg Type, ArgInfo))
    -> TCM (QName, Bool, QName, Arg Type, ArgInfo)
    forall a b. (a -> b) -> a -> b
    $ \case
                ([]   , []      ) -> TCM (QName, Bool, QName, Arg Type, ArgInfo)
    forall a. HasCallStack => a
    __IMPOSSIBLE__
                (TCErr
    err:[TCErr]
    _, []      ) -> TCErr -> TCM (QName, Bool, QName, Arg Type, ArgInfo)
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError TCErr
    err
                ([TCErr]
    _    , disambs :: [(QName, (Arg Type, ArgInfo, Maybe TCState))]
    disambs@((QName
    d,(Arg Type, ArgInfo, Maybe TCState)
    a):[(QName, (Arg Type, ArgInfo, Maybe TCState))]
    _)) -> TypeError -> TCM (QName, Bool, QName, Arg Type, ArgInfo)
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCError m) =>
    TypeError -> m a
    typeError (TypeError -> TCM (QName, Bool, QName, Arg Type, ArgInfo))
    -> (Doc -> TypeError)
    -> Doc
    -> TCM (QName, Bool, QName, Arg Type, ArgInfo)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Doc -> TypeError
    GenericDocError (Doc -> TCM (QName, Bool, QName, Arg Type, ArgInfo))
    -> TCMT IO Doc -> TCM (QName, Bool, QName, Arg Type, ArgInfo)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< [TCMT IO Doc] -> TCMT IO Doc
    forall (m :: * -> *) (t :: * -> *).
    (Applicative m, Foldable t) =>
    t (m Doc) -> m Doc
    vcat
                  [ TCMT IO Doc
    "Ambiguous projection " TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall a. Semigroup a => a -> a -> a
    <> QName -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM QName
    d TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall a. Semigroup a => a -> a -> a
    <> TCMT IO Doc
    "."
                  , TCMT IO Doc
    "It could refer to any of"
                  , 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] -> TCMT IO Doc) -> [TCMT IO Doc] -> TCMT IO Doc
    forall a b. (a -> b) -> a -> b
    $ ((QName, (Arg Type, ArgInfo, Maybe TCState)) -> TCMT IO Doc)
    -> [(QName, (Arg Type, ArgInfo, Maybe TCState))] -> [TCMT IO Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map (QName -> TCMT IO Doc
    prettyDisambProj (QName -> TCMT IO Doc)
    -> ((QName, (Arg Type, ArgInfo, Maybe TCState)) -> QName)
    -> (QName, (Arg Type, ArgInfo, Maybe TCState))
    -> TCMT IO Doc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (QName, (Arg Type, ArgInfo, Maybe TCState)) -> QName
    forall a b. (a, b) -> a
    fst) [(QName, (Arg Type, ArgInfo, Maybe TCState))]
    disambs
                  ]
        Defn
    _ -> TCM (QName, Bool, QName, Arg Type, ArgInfo)
    forall a. HasCallStack => a
    __IMPOSSIBLE__

      where
        tryDisambiguate :: Bool
    -> [Dom' Term QName]
    -> QName
    -> Args
    -> Bool
    -> (([TCErr], [(QName, (Arg Type, ArgInfo, Maybe TCState))])
        -> TCM (QName, Bool, QName, Arg Type, ArgInfo))
    -> TCM (QName, Bool, QName, Arg Type, ArgInfo)
    tryDisambiguate Bool
    constraintsOk [Dom' Term QName]
    fs QName
    r Args
    vs Bool
    comatching ([TCErr], [(QName, (Arg Type, ArgInfo, Maybe TCState))])
    -> TCM (QName, Bool, QName, Arg Type, ArgInfo)
    failure = do
          -- Note that tryProj wraps TCM in an ExceptT, collecting errors
          -- instead of throwing them to the user immediately.
          NonEmpty (Either TCErr (QName, (Arg Type, ArgInfo, Maybe TCState)))
    disambiguations <- (QName
     -> TCM (Either TCErr (QName, (Arg Type, ArgInfo, Maybe TCState))))
    -> List1 QName
    -> TCM
         (NonEmpty
            (Either TCErr (QName, (Arg Type, ArgInfo, Maybe TCState))))
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM (ExceptT TCErr (TCMT IO) (QName, (Arg Type, ArgInfo, Maybe TCState))
    -> TCM (Either TCErr (QName, (Arg Type, ArgInfo, Maybe TCState)))
    forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
    runExceptT (ExceptT
       TCErr (TCMT IO) (QName, (Arg Type, ArgInfo, Maybe TCState))
     -> TCM (Either TCErr (QName, (Arg Type, ArgInfo, Maybe TCState))))
    -> (QName
        -> ExceptT
             TCErr (TCMT IO) (QName, (Arg Type, ArgInfo, Maybe TCState)))
    -> QName
    -> TCM (Either TCErr (QName, (Arg Type, ArgInfo, Maybe TCState)))
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Bool
    -> [Dom' Term QName]
    -> QName
    -> Args
    -> QName
    -> ExceptT
         TCErr (TCMT IO) (QName, (Arg Type, ArgInfo, Maybe TCState))
    tryProj Bool
    constraintsOk [Dom' Term QName]
    fs QName
    r Args
    vs) List1 QName
    ds
          case NonEmpty (Either TCErr (QName, (Arg Type, ArgInfo, Maybe TCState)))
    -> ([TCErr], [(QName, (Arg Type, ArgInfo, Maybe TCState))])
    forall a b. List1 (Either a b) -> ([a], [b])
    List1.partitionEithers NonEmpty (Either TCErr (QName, (Arg Type, ArgInfo, Maybe TCState)))
    disambiguations of
            ([TCErr]
    _ , (QName
    d, (Arg Type
    a, ArgInfo
    ai, Maybe TCState
    mst)) : [(QName, (Arg Type, ArgInfo, Maybe TCState))]
    disambs) | Bool
    constraintsOk Bool -> Bool -> Bool
    forall a. Ord a => a -> a -> Bool
    <= [(QName, (Arg Type, ArgInfo, Maybe TCState))] -> Bool
    forall a. Null a => a -> Bool
    null [(QName, (Arg Type, ArgInfo, Maybe TCState))]
    disambs -> do
              (TCState -> TCMT IO ()) -> Maybe TCState -> TCMT IO ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ TCState -> TCMT IO ()
    forall (m :: * -> *). MonadTCState m => TCState -> m ()
    putTC Maybe TCState
    mst -- Activate state changes
              -- From here, we have the correctly disambiguated projection.
              -- For highlighting, we remember which name we disambiguated to.
              -- This is safe here (fingers crossed) as we won't decide on a
              -- different projection even if we backtrack and come here again.
              TCMT IO () -> TCMT IO ()
    forall (tcm :: * -> *) a. MonadTCM tcm => TCM a -> tcm a
    liftTCM (TCMT IO () -> TCMT IO ()) -> TCMT IO () -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ QName -> TCMT IO ()
    storeDisambiguatedProjection QName
    d
              (QName, Bool, QName, Arg Type, ArgInfo)
    -> TCM (QName, Bool, QName, Arg Type, ArgInfo)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (QName
    d, Bool
    comatching, QName
    r, Arg Type
    a, ArgInfo
    ai)
            ([TCErr], [(QName, (Arg Type, ArgInfo, Maybe TCState))])
    other -> ([TCErr], [(QName, (Arg Type, ArgInfo, Maybe TCState))])
    -> TCM (QName, Bool, QName, Arg Type, ArgInfo)
    failure ([TCErr], [(QName, (Arg Type, ArgInfo, Maybe TCState))])
    other

        notRecord :: TCM (QName, Bool, QName, Arg Type, ArgInfo)
    notRecord = QName -> TCM (QName, Bool, QName, Arg Type, ArgInfo)
    forall (m :: * -> *) a.
    (MonadTCM m, MonadError TCErr m, ReadTCState m) =>
    QName -> m a
    wrongProj (QName -> TCM (QName, Bool, QName, Arg Type, ArgInfo))
    -> QName -> TCM (QName, Bool, QName, Arg Type, ArgInfo)
    forall a b. (a -> b) -> a -> b
    $ List1 QName -> QName
    forall a. NonEmpty a -> a
    List1.head List1 QName
    ds

        wrongProj :: (MonadTCM m, MonadError TCErr m, ReadTCState m) => QName -> m a
        wrongProj :: forall (m :: * -> *) a.
    (MonadTCM m, MonadError TCErr m, ReadTCState m) =>
    QName -> m a
    wrongProj QName
    d = TypeError -> m a
    forall (m :: * -> *) a.
    (HasCallStack, ReadTCState m, MonadError TCErr m, MonadTCEnv m) =>
    TypeError -> m a
    softTypeError (TypeError -> m a) -> m TypeError -> m a
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< do
          TCM TypeError -> m TypeError
    forall (tcm :: * -> *) a. MonadTCM tcm => TCM a -> tcm a
    liftTCM (TCM TypeError -> m TypeError) -> TCM TypeError -> m TypeError
    forall a b. (a -> b) -> a -> b
    $ Doc -> TypeError
    GenericDocError (Doc -> TypeError) -> TCMT IO Doc -> TCM TypeError
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [TCMT IO Doc] -> TCMT IO Doc
    forall (m :: * -> *) (t :: * -> *).
    (Applicative m, Foldable t) =>
    t (m Doc) -> m Doc
    sep
            [ TCMT IO Doc
    "Cannot eliminate type "
            , Type -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM (Arg Type -> Type
    forall e. Arg e -> e
    unArg Arg Type
    b)
            , TCMT IO Doc
    " with projection "
            , if AmbiguousQName -> Bool
    isAmbiguous AmbiguousQName
    ambD then
                [Char] -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => [Char] -> m Doc
    text ([Char] -> TCMT IO Doc)
    -> (QName -> [Char]) -> QName -> TCMT IO Doc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . QName -> [Char]
    forall a. Pretty a => a -> [Char]
    prettyShow (QName -> TCMT IO Doc) -> TCMT IO QName -> TCMT IO Doc
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< QName -> TCMT IO QName
    dropTopLevelModule QName
    d
              else
                QName -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM QName
    d
            ]

        wrongHiding :: (MonadTCM m, MonadError TCErr m, ReadTCState m) => QName -> m a
        wrongHiding :: forall (m :: * -> *) a.
    (MonadTCM m, MonadError TCErr m, ReadTCState m) =>
    QName -> m a
    wrongHiding QName
    d = TypeError -> m a
    forall (m :: * -> *) a.
    (HasCallStack, ReadTCState m, MonadError TCErr m, MonadTCEnv m) =>
    TypeError -> m a
    softTypeError (TypeError -> m a) -> m TypeError -> m a
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< do
          TCM TypeError -> m TypeError
    forall (tcm :: * -> *) a. MonadTCM tcm => TCM a -> tcm a
    liftTCM (TCM TypeError -> m TypeError) -> TCM TypeError -> m TypeError
    forall a b. (a -> b) -> a -> b
    $ Doc -> TypeError
    GenericDocError (Doc -> TypeError) -> TCMT IO Doc -> TCM TypeError
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [TCMT IO Doc] -> TCMT IO Doc
    forall (m :: * -> *) (t :: * -> *).
    (Applicative m, Foldable t) =>
    t (m Doc) -> m Doc
    sep
            [ TCMT IO Doc
    "Wrong hiding used for projection " , QName -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM QName
    d ]

        tryProj
          :: Bool                 -- Are we allowed to create new constraints?
          -> [Dom QName]          -- Fields of record type under consideration.
          -> QName                -- Name of record type we are eliminating.
          -> Args                 -- Parameters of record type we are eliminating.
          -> QName                -- Candidate projection.
          -> ExceptT TCErr TCM (QName, (Arg Type, ArgInfo, Maybe TCState))
               -- TCState contains possibly new constraints/meta solutions.
        tryProj :: Bool
    -> [Dom' Term QName]
    -> QName
    -> Args
    -> QName
    -> ExceptT
         TCErr (TCMT IO) (QName, (Arg Type, ArgInfo, Maybe TCState))
    tryProj Bool
    constraintsOk [Dom' Term QName]
    fs QName
    r Args
    vs QName
    d0 = QName -> ExceptT TCErr (TCMT IO) (Maybe Projection)
    forall (m :: * -> *).
    HasConstInfo m =>
    QName -> m (Maybe Projection)
    isProjection QName
    d0 ExceptT TCErr (TCMT IO) (Maybe Projection)
    -> (Maybe Projection
        -> ExceptT
             TCErr (TCMT IO) (QName, (Arg Type, ArgInfo, Maybe TCState)))
    -> ExceptT
         TCErr (TCMT IO) (QName, (Arg Type, ArgInfo, Maybe TCState))
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \case
          -- Not a projection
          Maybe Projection
    Nothing -> QName
    -> ExceptT
         TCErr (TCMT IO) (QName, (Arg Type, ArgInfo, Maybe TCState))
    forall (m :: * -> *) a.
    (MonadTCM m, MonadError TCErr m, ReadTCState m) =>
    QName -> m a
    wrongProj QName
    d0
          Just Projection
    proj -> do
            let d :: QName
    d = Projection -> QName
    projOrig Projection
    proj

            -- Andreas, 2015-05-06 issue 1413 projProper=Nothing is not impossible
            QName
    qr <- ExceptT TCErr (TCMT IO) QName
    -> (QName -> ExceptT TCErr (TCMT IO) QName)
    -> Maybe QName
    -> ExceptT TCErr (TCMT IO) QName
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe (QName -> ExceptT TCErr (TCMT IO) QName
    forall (m :: * -> *) a.
    (MonadTCM m, MonadError TCErr m, ReadTCState m) =>
    QName -> m a
    wrongProj QName
    d) QName -> ExceptT TCErr (TCMT IO) QName
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe QName -> ExceptT TCErr (TCMT IO) QName)
    -> Maybe QName -> ExceptT TCErr (TCMT IO) QName
    forall a b. (a -> b) -> a -> b
    $ Projection -> Maybe QName
    projProper Projection
    proj

            -- If projIndex==0, then the projection is already applied
            -- to the record value (like in @open R r@), and then it
            -- is no longer a projection but a record field.
            Bool -> ExceptT TCErr (TCMT IO) () -> ExceptT TCErr (TCMT IO) ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (ProjLams -> Bool
    forall a. Null a => a -> Bool
    null (ProjLams -> Bool) -> ProjLams -> Bool
    forall a b. (a -> b) -> a -> b
    $ Projection -> ProjLams
    projLams Projection
    proj) (ExceptT TCErr (TCMT IO) () -> ExceptT TCErr (TCMT IO) ())
    -> ExceptT TCErr (TCMT IO) () -> ExceptT TCErr (TCMT IO) ()
    forall a b. (a -> b) -> a -> b
    $ QName -> ExceptT TCErr (TCMT IO) ()
    forall (m :: * -> *) a.
    (MonadTCM m, MonadError TCErr m, ReadTCState m) =>
    QName -> m a
    wrongProj QName
    d
            [Char] -> Int -> [Char] -> ExceptT TCErr (TCMT IO) ()
    forall (m :: * -> *).
    MonadDebug m =>
    [Char] -> Int -> [Char] -> m ()
    reportSLn [Char]
    "tc.lhs.split" Int
    90 [Char]
    "we are a projection pattern"
            -- If the target is not a record type, that's an error.
            -- It could be a meta, but since we cannot postpone lhs checking, we crash here.
            [Char] -> Int -> TCMT IO Doc -> ExceptT TCErr (TCMT IO) ()
    forall (m :: * -> *).
    MonadDebug m =>
    [Char] -> Int -> TCMT IO Doc -> m ()
    reportSDoc [Char]
    "tc.lhs.split" Int
    20 (TCMT IO Doc -> ExceptT TCErr (TCMT IO) ())
    -> TCMT IO Doc -> ExceptT TCErr (TCMT IO) ()
    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
              [ [Char] -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => [Char] -> m Doc
    text ([Char] -> TCMT IO Doc) -> [Char] -> TCMT IO Doc
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "proj                  d0 = " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ QName -> [Char]
    forall a. Pretty a => a -> [Char]
    prettyShow QName
    d0
              , [Char] -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => [Char] -> m Doc
    text ([Char] -> TCMT IO Doc) -> [Char] -> TCMT IO Doc
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "original proj         d  = " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ QName -> [Char]
    forall a. Pretty a => a -> [Char]
    prettyShow QName
    d
              ]
            -- Get the field decoration.
            -- If the projection pattern name @d@ is not a field name,
            -- we have to try the next projection name.
            -- If this was not an ambiguous projection, that's an error.
            Dom' Term QName
    argd <- ExceptT TCErr (TCMT IO) (Dom' Term QName)
    -> (Dom' Term QName -> ExceptT TCErr (TCMT IO) (Dom' Term QName))
    -> Maybe (Dom' Term QName)
    -> ExceptT TCErr (TCMT IO) (Dom' Term QName)
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe (QName -> ExceptT TCErr (TCMT IO) (Dom' Term QName)
    forall (m :: * -> *) a.
    (MonadTCM m, MonadError TCErr m, ReadTCState m) =>
    QName -> m a
    wrongProj QName
    d) Dom' Term QName -> ExceptT TCErr (TCMT IO) (Dom' Term QName)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe (Dom' Term QName)
     -> ExceptT TCErr (TCMT IO) (Dom' Term QName))
    -> Maybe (Dom' Term QName)
    -> ExceptT TCErr (TCMT IO) (Dom' Term QName)
    forall a b. (a -> b) -> a -> b
    $ (Dom' Term QName -> Bool)
    -> [Dom' Term QName] -> Maybe (Dom' Term QName)
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
    List.find ((QName
    d QName -> QName -> Bool
    forall a. Eq a => a -> a -> Bool
    ==) (QName -> Bool)
    -> (Dom' Term QName -> QName) -> Dom' Term QName -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Dom' Term QName -> QName
    forall t e. Dom' t e -> e
    unDom) [Dom' Term QName]
    fs

            -- Issue4998: This used to use the hiding from the principal argument, but this is not
            -- relevant for the ArgInfo of the clause rhs. We return that separately so we can set the
            -- correct hiding for the projection pattern in splitRest above.
            let ai :: ArgInfo
    ai = Dom' Term QName -> ArgInfo
    forall a. LensArgInfo a => a -> ArgInfo
    getArgInfo Dom' Term QName
    argd

            [Char] -> Int -> TCMT IO Doc -> ExceptT TCErr (TCMT IO) ()
    forall (m :: * -> *).
    MonadDebug m =>
    [Char] -> Int -> TCMT IO Doc -> m ()
    reportSDoc [Char]
    "tc.lhs.split" Int
    20 (TCMT IO Doc -> ExceptT TCErr (TCMT IO) ())
    -> TCMT IO Doc -> ExceptT TCErr (TCMT IO) ()
    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
              [ [Char] -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => [Char] -> m Doc
    text ([Char] -> TCMT IO Doc) -> [Char] -> TCMT IO Doc
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "original proj relevance  = " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Relevance -> [Char]
    forall a. Show a => a -> [Char]
    show (Dom' Term QName -> Relevance
    forall a. LensRelevance a => a -> Relevance
    getRelevance Dom' Term QName
    argd)
              , [Char] -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => [Char] -> m Doc
    text ([Char] -> TCMT IO Doc) -> [Char] -> TCMT IO Doc
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "original proj quantity   = " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Quantity -> [Char]
    forall a. Show a => a -> [Char]
    show (Dom' Term QName -> Quantity
    forall a. LensQuantity a => a -> Quantity
    getQuantity  Dom' Term QName
    argd)
              ]
            -- Andreas, 2016-12-31, issue #2374:
            -- We can also disambiguate by hiding info.
            -- Andreas, 2018-10-18, issue #3289: postfix projections have no hiding info.
            Bool -> ExceptT TCErr (TCMT IO) () -> ExceptT TCErr (TCMT IO) ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless (Maybe Hiding -> Bool -> (Hiding -> Bool) -> Bool
    forall a b. Maybe a -> b -> (a -> b) -> b
    caseMaybe Maybe Hiding
    h Bool
    True ((Hiding -> Bool) -> Bool) -> (Hiding -> Bool) -> Bool
    forall a b. (a -> b) -> a -> b
    $ ArgInfo -> Hiding -> Bool
    forall a b. (LensHiding a, LensHiding b) => a -> b -> Bool
    sameHiding (ArgInfo -> Hiding -> Bool) -> ArgInfo -> Hiding -> Bool
    forall a b. (a -> b) -> a -> b
    $ Projection -> ArgInfo
    projArgInfo Projection
    proj) (ExceptT TCErr (TCMT IO) () -> ExceptT TCErr (TCMT IO) ())
    -> ExceptT TCErr (TCMT IO) () -> ExceptT TCErr (TCMT IO) ()
    forall a b. (a -> b) -> a -> b
    $ QName -> ExceptT TCErr (TCMT IO) ()
    forall (m :: * -> *) a.
    (MonadTCM m, MonadError TCErr m, ReadTCState m) =>
    QName -> m a
    wrongHiding QName
    d

            -- Andreas, 2016-12-31, issue #1976: Check parameters.
            let chk :: TCMT IO ()
    chk = QName -> QName -> Args -> TCMT IO ()
    forall (tcm :: * -> *).
    MonadTCM tcm =>
    QName -> QName -> Args -> tcm ()
    checkParameters QName
    qr QName
    r Args
    vs
            Maybe TCState
    mst <- TCM (Maybe TCState) -> ExceptT TCErr (TCMT IO) (Maybe TCState)
    forall (m :: * -> *) a.
    (MonadTCM m, MonadError TCErr m) =>
    TCM a -> m a
    suspendErrors (TCM (Maybe TCState) -> ExceptT TCErr (TCMT IO) (Maybe TCState))
    -> TCM (Maybe TCState) -> ExceptT TCErr (TCMT IO) (Maybe TCState)
    forall a b. (a -> b) -> a -> b
    $
              if Bool
    constraintsOk then TCState -> Maybe TCState
    forall a. a -> Maybe a
    Just (TCState -> Maybe TCState)
    -> (((), TCState) -> TCState) -> ((), TCState) -> Maybe TCState
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((), TCState) -> TCState
    forall a b. (a, b) -> b
    snd (((), TCState) -> Maybe TCState)
    -> TCMT IO ((), TCState) -> TCM (Maybe TCState)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> TCMT IO () -> TCMT IO ((), TCState)
    forall a. TCM a -> TCM (a, TCState)
    localTCStateSaving TCMT IO ()
    chk
              else Maybe TCState
    forall a. Maybe a
    Nothing Maybe TCState -> TCMT IO () -> TCM (Maybe TCState)
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ TCMT IO () -> TCMT IO ()
    forall (m :: * -> *) a.
    (HasOptions m, MonadConstraint m, MonadDebug m, MonadError TCErr m,
     MonadFresh ProblemId m, MonadTCEnv m, MonadWarning m) =>
    m a -> m a
    nonConstraining TCMT IO ()
    chk

            -- Get the type of projection d applied to "self"
            Type
    dType <- TCMT IO Type -> ExceptT TCErr (TCMT IO) Type
    forall (tcm :: * -> *) a. MonadTCM tcm => TCM a -> tcm a
    liftTCM (TCMT IO Type -> ExceptT TCErr (TCMT IO) Type)
    -> TCMT IO Type -> ExceptT TCErr (TCMT IO) Type
    forall a b. (a -> b) -> a -> b
    $ Definition -> Type
    defType (Definition -> Type) -> TCMT IO Definition -> TCMT IO Type
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> QName -> TCMT IO Definition
    forall (m :: * -> *). HasConstInfo m => QName -> m Definition
    getConstInfo QName
    d  -- full type!
            [Char] -> Int -> TCMT IO Doc -> ExceptT TCErr (TCMT IO) ()
    forall (m :: * -> *).
    MonadDebug m =>
    [Char] -> Int -> TCMT IO Doc -> m ()
    reportSDoc [Char]
    "tc.lhs.split" Int
    20 (TCMT IO Doc -> ExceptT TCErr (TCMT IO) ())
    -> TCMT IO Doc -> ExceptT TCErr (TCMT IO) ()
    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
    "we are being projected by dType = " 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
    dType
              ]
            Type
    projType <- TCMT IO Type -> ExceptT TCErr (TCMT IO) Type
    forall (tcm :: * -> *) a. MonadTCM tcm => TCM a -> tcm a
    liftTCM (TCMT IO Type -> ExceptT TCErr (TCMT IO) Type)
    -> TCMT IO Type -> ExceptT TCErr (TCMT IO) Type
    forall a b. (a -> b) -> a -> b
    $ Type
    dType Type -> Args -> TCMT IO Type
    forall a (m :: * -> *).
    (PiApplyM a, MonadReduce m, HasBuiltins m) =>
    Type -> a -> m Type
    `piApplyM` Args
    vs
            (QName, (Arg Type, ArgInfo, Maybe TCState))
    -> ExceptT
         TCErr (TCMT IO) (QName, (Arg Type, ArgInfo, Maybe TCState))
    forall (m :: * -> *) a. Monad m => a -> m a
    return (QName
    d0, (ArgInfo -> Type -> Arg Type
    forall e. ArgInfo -> e -> Arg e
    Arg ArgInfo
    ai Type
    projType, Projection -> ArgInfo
    projArgInfo Projection
    proj, Maybe TCState
    mst))

    -- | Disambiguate a constructor based on the data type it is supposed to be
    --   constructing. Returns the unambiguous constructor name and its type.
    --   Precondition: type should be a data/record type.
    disambiguateConstructor
      :: AmbiguousQName    -- ^ The name of the constructor to be disambiguated.
      -> QName             -- ^ Name of the datatype.
      -> Args              -- ^ Parameters of the datatype
      -> TCM (ConHead, Type)
    disambiguateConstructor :: AmbiguousQName -> QName -> Args -> TCM (ConHead, Type)
    disambiguateConstructor ambC :: AmbiguousQName
    ambC@(AmbQ List1 QName
    cs) QName
    d Args
    pars = do
      QName
    d <- QName -> TCMT IO QName
    forall (m :: * -> *). HasConstInfo m => QName -> m QName
    canonicalName QName
    d
      [QName]
    cons <- Definition -> Defn
    theDef (Definition -> Defn) -> TCMT IO Definition -> TCMT IO Defn
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> QName -> TCMT IO Definition
    forall (m :: * -> *). HasConstInfo m => QName -> m Definition
    getConstInfo QName
    d TCMT IO Defn -> (Defn -> TCMT IO [QName]) -> TCMT IO [QName]
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \case
        def :: Defn
    def@Datatype{} -> [QName] -> TCMT IO [QName]
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([QName] -> TCMT IO [QName]) -> [QName] -> TCMT IO [QName]
    forall a b. (a -> b) -> a -> b
    $ Defn -> [QName]
    dataCons Defn
    def
        def :: Defn
    def@Record{}   -> [QName] -> TCMT IO [QName]
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([QName] -> TCMT IO [QName]) -> [QName] -> TCMT IO [QName]
    forall a b. (a -> b) -> a -> b
    $ [ConHead -> QName
    conName (ConHead -> QName) -> ConHead -> QName
    forall a b. (a -> b) -> a -> b
    $ Defn -> ConHead
    recConHead Defn
    def]
        Defn
    _              -> TCMT IO [QName]
    forall a. HasCallStack => a
    __IMPOSSIBLE__

      -- First, try do disambiguate with nonConstraining,
      -- if that fails, try again allowing constraint/solution generation.
      Bool
    -> QName
    -> [QName]
    -> (([TCErr], [List1 (QName, ConHead, (Type, Maybe TCState))])
        -> TCM (ConHead, Type))
    -> TCM (ConHead, Type)
    tryDisambiguate Bool
    False QName
    d [QName]
    cons ((([TCErr], [List1 (QName, ConHead, (Type, Maybe TCState))])
      -> TCM (ConHead, Type))
     -> TCM (ConHead, Type))
    -> (([TCErr], [List1 (QName, ConHead, (Type, Maybe TCState))])
        -> TCM (ConHead, Type))
    -> TCM (ConHead, Type)
    forall a b. (a -> b) -> a -> b
    $ \ ([TCErr], [List1 (QName, ConHead, (Type, Maybe TCState))])
    _ ->
        Bool
    -> QName
    -> [QName]
    -> (([TCErr], [List1 (QName, ConHead, (Type, Maybe TCState))])
        -> TCM (ConHead, Type))
    -> TCM (ConHead, Type)
    tryDisambiguate Bool
    True QName
    d [QName]
    cons ((([TCErr], [List1 (QName, ConHead, (Type, Maybe TCState))])
      -> TCM (ConHead, Type))
     -> TCM (ConHead, Type))
    -> (([TCErr], [List1 (QName, ConHead, (Type, Maybe TCState))])
        -> TCM (ConHead, Type))
    -> TCM (ConHead, Type)
    forall a b. (a -> b) -> a -> b
    $ \case
            ([]   , [] ) -> TCM (ConHead, Type)
    forall a. HasCallStack => a
    __IMPOSSIBLE__
            (TCErr
    err:[TCErr]
    _, [] ) -> TCErr -> TCM (ConHead, Type)
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError TCErr
    err
            -- If all disambiguations point to the same original constructor
            -- meaning that only the parameters may differ,
            -- then throw more specific error.
            ([TCErr]
    _    , [List1 (QName, ConHead, (Type, Maybe TCState))
    _]) -> TypeError -> TCM (ConHead, Type)
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCError m) =>
    TypeError -> m a
    typeError (TypeError -> TCM (ConHead, Type))
    -> TypeError -> TCM (ConHead, Type)
    forall a b. (a -> b) -> a -> b
    $ QName -> List1 QName -> TypeError
    CantResolveOverloadedConstructorsTargetingSameDatatype QName
    d List1 QName
    cs
            ([TCErr]
    _    , disambs :: [List1 (QName, ConHead, (Type, Maybe TCState))]
    disambs@(((QName
    c,ConHead
    _,(Type, Maybe TCState)
    _):|[(QName, ConHead, (Type, Maybe TCState))]
    _):[List1 (QName, ConHead, (Type, Maybe TCState))]
    _)) -> TypeError -> TCM (ConHead, Type)
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCError m) =>
    TypeError -> m a
    typeError (TypeError -> TCM (ConHead, Type))
    -> (Doc -> TypeError) -> Doc -> TCM (ConHead, Type)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Doc -> TypeError
    GenericDocError (Doc -> TCM (ConHead, Type)) -> TCMT IO Doc -> TCM (ConHead, Type)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< [TCMT IO Doc] -> TCMT IO Doc
    forall (m :: * -> *) (t :: * -> *).
    (Applicative m, Foldable t) =>
    t (m Doc) -> m Doc
    vcat
              [ TCMT IO Doc
    "Ambiguous constructor " TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall a. Semigroup a => a -> a -> a
    <> Name -> TCMT IO Doc
    forall (m :: * -> *) a. (Applicative m, Pretty a) => a -> m Doc
    pretty (QName -> Name
    qnameName QName
    c) TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall a. Semigroup a => a -> a -> a
    <> TCMT IO Doc
    "."
              , TCMT IO Doc
    "It could refer to any of"
              , 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] -> TCMT IO Doc) -> [TCMT IO Doc] -> TCMT IO Doc
    forall a b. (a -> b) -> a -> b
    $ ((QName, ConHead, (Type, Maybe TCState)) -> TCMT IO Doc)
    -> [(QName, ConHead, (Type, Maybe TCState))] -> [TCMT IO Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map (QName -> TCMT IO Doc
    prettyDisambCons (QName -> TCMT IO Doc)
    -> ((QName, ConHead, (Type, Maybe TCState)) -> QName)
    -> (QName, ConHead, (Type, Maybe TCState))
    -> TCMT IO Doc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ConHead -> QName
    conName (ConHead -> QName)
    -> ((QName, ConHead, (Type, Maybe TCState)) -> ConHead)
    -> (QName, ConHead, (Type, Maybe TCState))
    -> QName
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (QName, ConHead, (Type, Maybe TCState)) -> ConHead
    forall a b c. (a, b, c) -> b
    snd3) ([(QName, ConHead, (Type, Maybe TCState))] -> [TCMT IO Doc])
    -> [(QName, ConHead, (Type, Maybe TCState))] -> [TCMT IO Doc]
    forall a b. (a -> b) -> a -> b
    $ [List1 (QName, ConHead, (Type, Maybe TCState))]
    -> [(QName, ConHead, (Type, Maybe TCState))]
    forall a. [List1 a] -> [a]
    List1.concat [List1 (QName, ConHead, (Type, Maybe TCState))]
    disambs
              ]

      where
        tryDisambiguate
          :: Bool     -- May we constrain/solve metas to arrive at unique disambiguation?
          -> QName    -- Data/record type.
          -> [QName]  -- Its constructor(s).
          -> ( ( [TCErr]
               , [List1 (QName, ConHead, (Type, Maybe TCState))]
               )
               -> TCM (ConHead, Type) )  -- Failure continuation, taking
                                         -- possible disambiguations
                                         -- grouped by the original
                                         -- constructor name in 'ConHead'.
          -> TCM (ConHead, Type)  -- Unique disambiguation and its type.
        tryDisambiguate :: Bool
    -> QName
    -> [QName]
    -> (([TCErr], [List1 (QName, ConHead, (Type, Maybe TCState))])
        -> TCM (ConHead, Type))
    -> TCM (ConHead, Type)
    tryDisambiguate Bool
    constraintsOk QName
    d [QName]
    cons ([TCErr], [List1 (QName, ConHead, (Type, Maybe TCState))])
    -> TCM (ConHead, Type)
    failure = do
          [Char] -> Int -> TCMT IO Doc -> TCMT IO ()
    forall (m :: * -> *).
    MonadDebug m =>
    [Char] -> Int -> TCMT IO Doc -> m ()
    reportSDoc [Char]
    "tc.lhs.disamb" Int
    30 (TCMT IO Doc -> TCMT IO ()) -> TCMT IO Doc -> TCMT IO ()
    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]] -> [TCMT IO Doc]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    List.concat ([[TCMT IO Doc]] -> [TCMT IO Doc])
    -> [[TCMT IO Doc]] -> [TCMT IO Doc]
    forall a b. (a -> b) -> a -> b
    $
            [ [ TCMT IO Doc
    "tryDisambiguate" ]
            , if Bool
    constraintsOk then [ TCMT IO Doc
    "(allowing new constraints)" ] else [TCMT IO Doc]
    forall a. Null a => a
    empty
            , (QName -> TCMT IO Doc) -> [QName] -> [TCMT IO Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map (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)
    -> (QName -> TCMT IO Doc) -> QName -> TCMT IO Doc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . QName -> TCMT IO Doc
    forall (m :: * -> *) a. (Applicative m, Pretty a) => a -> m Doc
    pretty) ([QName] -> [TCMT IO Doc]) -> [QName] -> [TCMT IO Doc]
    forall a b. (a -> b) -> a -> b
    $ List1 QName -> [QName]
    forall a. NonEmpty a -> [a]
    List1.toList List1 QName
    cs
            , [ TCMT IO Doc
    "against" ]
            , (QName -> TCMT IO Doc) -> [QName] -> [TCMT IO Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map (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)
    -> (QName -> TCMT IO Doc) -> QName -> TCMT IO Doc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . QName -> TCMT IO Doc
    forall (m :: * -> *) a. (Applicative m, Pretty a) => a -> m Doc
    pretty) [QName]
    cons
            ]
          NonEmpty (Either TCErr (QName, ConHead, (Type, Maybe TCState)))
    disambiguations <- (QName
     -> TCM (Either TCErr (QName, ConHead, (Type, Maybe TCState))))
    -> List1 QName
    -> TCM
         (NonEmpty (Either TCErr (QName, ConHead, (Type, Maybe TCState))))
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM (ExceptT TCErr (TCMT IO) (QName, ConHead, (Type, Maybe TCState))
    -> TCM (Either TCErr (QName, ConHead, (Type, Maybe TCState)))
    forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
    runExceptT (ExceptT TCErr (TCMT IO) (QName, ConHead, (Type, Maybe TCState))
     -> TCM (Either TCErr (QName, ConHead, (Type, Maybe TCState))))
    -> (QName
        -> ExceptT TCErr (TCMT IO) (QName, ConHead, (Type, Maybe TCState)))
    -> QName
    -> TCM (Either TCErr (QName, ConHead, (Type, Maybe TCState)))
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Bool
    -> [QName]
    -> QName
    -> Args
    -> QName
    -> ExceptT TCErr (TCMT IO) (QName, ConHead, (Type, Maybe TCState))
    tryCon Bool
    constraintsOk [QName]
    cons QName
    d Args
    pars) List1 QName
    cs
          -- Q: can we be more lazy, like using the ListT monad?
          -- Andreas, 2020-06-17: Not really, since we need to make sure
          -- that only a single candidate remains, and if not,
          -- report all alternatives in the error message.
          let ([TCErr]
    errs, [(QName, ConHead, (Type, Maybe TCState))]
    fits0) = NonEmpty (Either TCErr (QName, ConHead, (Type, Maybe TCState)))
    -> ([TCErr], [(QName, ConHead, (Type, Maybe TCState))])
    forall a b. List1 (Either a b) -> ([a], [b])
    List1.partitionEithers NonEmpty (Either TCErr (QName, ConHead, (Type, Maybe TCState)))
    disambiguations
          [Char] -> Int -> TCMT IO Doc -> TCMT IO ()
    forall (m :: * -> *).
    MonadDebug m =>
    [Char] -> Int -> TCMT IO Doc -> m ()
    reportSDoc [Char]
    "tc.lhs.disamb" Int
    40 (TCMT IO Doc -> TCMT IO ()) -> TCMT IO Doc -> TCMT IO ()
    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
    $ do
            let hideSt :: (a, b, (a, f b)) -> (a, b, (a, f [Char]))
    hideSt (a
    c0,b
    c,(a
    a,f b
    mst)) = (a
    c0, b
    c, (a
    a, ([Char]
    "(state change)" :: String) [Char] -> f b -> f [Char]
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ f b
    mst))
            TCMT IO Doc
    "remaining candidates: " TCMT IO Doc -> [TCMT IO Doc] -> [TCMT IO Doc]
    forall a. a -> [a] -> [a]
    : ((QName, ConHead, (Type, Maybe TCState)) -> TCMT IO Doc)
    -> [(QName, ConHead, (Type, Maybe TCState))] -> [TCMT IO Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map (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)
    -> ((QName, ConHead, (Type, Maybe TCState)) -> TCMT IO Doc)
    -> (QName, ConHead, (Type, Maybe TCState))
    -> TCMT IO Doc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (QName, ConHead, (Type, Maybe [Char])) -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM ((QName, ConHead, (Type, Maybe [Char])) -> TCMT IO Doc)
    -> ((QName, ConHead, (Type, Maybe TCState))
        -> (QName, ConHead, (Type, Maybe [Char])))
    -> (QName, ConHead, (Type, Maybe TCState))
    -> TCMT IO Doc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (QName, ConHead, (Type, Maybe TCState))
    -> (QName, ConHead, (Type, Maybe [Char]))
    forall {f :: * -> *} {a} {b} {a} {b}.
    Functor f =>
    (a, b, (a, f b)) -> (a, b, (a, f [Char]))
    hideSt) [(QName, ConHead, (Type, Maybe TCState))]
    fits0
          [(QName, ConHead, (Type, Maybe TCState))]
    -> TCM [List1 (QName, ConHead, (Type, Maybe TCState))]
    forall a.
    [(a, ConHead, (Type, Maybe TCState))]
    -> TCM [List1 (a, ConHead, (Type, Maybe TCState))]
    dedupCons [(QName, ConHead, (Type, Maybe TCState))]
    fits0 TCM [List1 (QName, ConHead, (Type, Maybe TCState))]
    -> ([List1 (QName, ConHead, (Type, Maybe TCState))]
        -> TCM (ConHead, Type))
    -> TCM (ConHead, Type)
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \case

            -- Single candidate remains.
            [ (QName
    c0,ConHead
    c,(Type
    a,Maybe TCState
    mst)) :| [] ] -> do
              [Char] -> Int -> TCMT IO Doc -> TCMT IO ()
    forall (m :: * -> *).
    MonadDebug m =>
    [Char] -> Int -> TCMT IO Doc -> m ()
    reportSDoc [Char]
    "tc.lhs.disamb" Int
    30 (TCMT IO Doc -> TCMT IO ()) -> TCMT IO Doc -> TCMT IO ()
    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
    "tryDisambiguate suceeds with"
                , QName -> TCMT IO Doc
    forall (m :: * -> *) a. (Applicative m, Pretty a) => a -> m Doc
    pretty QName
    c0
                , TCMT IO Doc
    ":"
                , Type -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM Type
    a
                ]
              -- Andreas, 2020-06-16, issue #4135
              -- If disambiguation succeeded with new constraints/solutions,
              -- put them into action.
              Maybe TCState -> (TCState -> TCMT IO ()) -> TCMT IO ()
    forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
    whenJust Maybe TCState
    mst TCState -> TCMT IO ()
    forall (m :: * -> *). MonadTCState m => TCState -> m ()
    putTC
              -- If there are multiple candidates for the constructor pattern, exactly one of
              -- which type checks, remember our choice for highlighting info.
              Bool -> TCMT IO () -> TCMT IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (AmbiguousQName -> Bool
    isAmbiguous AmbiguousQName
    ambC) (TCMT IO () -> TCMT IO ()) -> TCMT IO () -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ TCMT IO () -> TCMT IO ()
    forall (tcm :: * -> *) a. MonadTCM tcm => TCM a -> tcm a
    liftTCM (TCMT IO () -> TCMT IO ()) -> TCMT IO () -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $
                Induction -> QName -> TCMT IO ()
    storeDisambiguatedConstructor (ConHead -> Induction
    conInductive ConHead
    c) QName
    c0
              (ConHead, Type) -> TCM (ConHead, Type)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (ConHead
    c,Type
    a)

            -- Either no candidate constructor in 'cs' type checks, or multiple candidates
            -- type check.
            [List1 (QName, ConHead, (Type, Maybe TCState))]
    groups -> ([TCErr], [List1 (QName, ConHead, (Type, Maybe TCState))])
    -> TCM (ConHead, Type)
    failure ([TCErr]
    errs, [List1 (QName, ConHead, (Type, Maybe TCState))]
    groups)

        abstractConstructor :: QName -> m a
    abstractConstructor QName
    c = TypeError -> m a
    forall (m :: * -> *) a.
    (HasCallStack, ReadTCState m, MonadError TCErr m, MonadTCEnv m) =>
    TypeError -> m a
    softTypeError (TypeError -> m a) -> TypeError -> m a
    forall a b. (a -> b) -> a -> b
    $
          QName -> TypeError
    AbstractConstructorNotInScope QName
    c

        wrongDatatype :: QName -> QName -> m a
    wrongDatatype QName
    c QName
    d = TypeError -> m a
    forall (m :: * -> *) a.
    (HasCallStack, ReadTCState m, MonadError TCErr m, MonadTCEnv m) =>
    TypeError -> m a
    softTypeError (TypeError -> m a) -> TypeError -> m a
    forall a b. (a -> b) -> a -> b
    $
          QName -> QName -> TypeError
    ConstructorPatternInWrongDatatype QName
    c QName
    d

        tryCon
          :: Bool        -- Are we allowed to constrain metas?
          -> [QName]     -- Constructors of data type under consideration.
          -> QName       -- Name of data/record type we are eliminating.
          -> Args        -- Parameters of data/record type we are eliminating.
          -> QName       -- Candidate constructor.
          -> ExceptT TCErr TCM (QName, ConHead, (Type, Maybe TCState))
               -- If this candidate succeeds, return its disambiguation
               -- its type, and maybe the state obtained after checking it
               -- (which may contain new constraints/solutions).
        tryCon :: Bool
    -> [QName]
    -> QName
    -> Args
    -> QName
    -> ExceptT TCErr (TCMT IO) (QName, ConHead, (Type, Maybe TCState))
    tryCon Bool
    constraintsOk [QName]
    cons QName
    d Args
    pars QName
    c = QName -> ExceptT TCErr (TCMT IO) (Either SigError Definition)
    forall (m :: * -> *).
    HasConstInfo m =>
    QName -> m (Either SigError Definition)
    getConstInfo' QName
    c ExceptT TCErr (TCMT IO) (Either SigError Definition)
    -> (Either SigError Definition
        -> ExceptT TCErr (TCMT IO) (QName, ConHead, (Type, Maybe TCState)))
    -> ExceptT TCErr (TCMT IO) (QName, ConHead, (Type, Maybe TCState))
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \case
          Left (SigUnknown [Char]
    err) -> ExceptT TCErr (TCMT IO) (QName, ConHead, (Type, Maybe TCState))
    forall a. HasCallStack => a
    __IMPOSSIBLE__
          Left SigError
    SigAbstract -> QName
    -> ExceptT TCErr (TCMT IO) (QName, ConHead, (Type, Maybe TCState))
    forall {m :: * -> *} {a}.
    (ReadTCState m, MonadError TCErr m, MonadTCEnv m) =>
    QName -> m a
    abstractConstructor QName
    c
          Right Definition
    def -> do
            let con :: ConHead
    con = Defn -> ConHead
    conSrcCon (Definition -> Defn
    theDef Definition
    def) ConHead -> QName -> ConHead
    forall t u. (SetRange t, HasRange u) => t -> u -> t
    `withRangeOf` QName
    c
            Bool -> ExceptT TCErr (TCMT IO) () -> ExceptT TCErr (TCMT IO) ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless (ConHead -> QName
    conName ConHead
    con QName -> [QName] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [QName]
    cons) (ExceptT TCErr (TCMT IO) () -> ExceptT TCErr (TCMT IO) ())
    -> ExceptT TCErr (TCMT IO) () -> ExceptT TCErr (TCMT IO) ()
    forall a b. (a -> b) -> a -> b
    $ QName -> QName -> ExceptT TCErr (TCMT IO) ()
    forall {m :: * -> *} {a}.
    (ReadTCState m, MonadError TCErr m, MonadTCEnv m) =>
    QName -> QName -> m a
    wrongDatatype QName
    c QName
    d

            -- Andreas, 2013-03-22 fixing issue 279
            -- To resolve ambiguous constructors, Agda always looks up
            -- their original definition and reconstructs the parameters
            -- from the type @Def d vs@ we check against.
            -- However, the constructor could come from a module instantiation
            -- with some of the parameters already fixed.
            -- Agda did not make sure the two parameter lists coincide,
            -- so we add a check here.
            -- I guess this issue could be solved more systematically,
            -- but the extra check here is non-invasive to the existing code.
            -- Andreas, 2016-12-31 fixing issue #1975
            -- Do this also for constructors which were originally ambiguous.
            let chk :: TCMT IO ()
    chk = QName -> QName -> Args -> TCMT IO ()
    forall (tcm :: * -> *).
    MonadTCM tcm =>
    QName -> QName -> Args -> tcm ()
    checkConstructorParameters QName
    c QName
    d Args
    pars
            Maybe TCState
    mst <- TCM (Maybe TCState) -> ExceptT TCErr (TCMT IO) (Maybe TCState)
    forall (m :: * -> *) a.
    (MonadTCM m, MonadError TCErr m) =>
    TCM a -> m a
    suspendErrors (TCM (Maybe TCState) -> ExceptT TCErr (TCMT IO) (Maybe TCState))
    -> TCM (Maybe TCState) -> ExceptT TCErr (TCMT IO) (Maybe TCState)
    forall a b. (a -> b) -> a -> b
    $
              if Bool
    constraintsOk then TCState -> Maybe TCState
    forall a. a -> Maybe a
    Just (TCState -> Maybe TCState)
    -> (((), TCState) -> TCState) -> ((), TCState) -> Maybe TCState
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((), TCState) -> TCState
    forall a b. (a, b) -> b
    snd (((), TCState) -> Maybe TCState)
    -> TCMT IO ((), TCState) -> TCM (Maybe TCState)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> TCMT IO () -> TCMT IO ((), TCState)
    forall a. TCM a -> TCM (a, TCState)
    localTCStateSaving TCMT IO ()
    chk
              else Maybe TCState
    forall a. Maybe a
    Nothing Maybe TCState -> TCMT IO () -> TCM (Maybe TCState)
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ TCMT IO () -> TCMT IO ()
    forall (m :: * -> *) a.
    (HasOptions m, MonadConstraint m, MonadDebug m, MonadError TCErr m,
     MonadFresh ProblemId m, MonadTCEnv m, MonadWarning m) =>
    m a -> m a
    nonConstraining TCMT IO ()
    chk

            -- Get the type from the original constructor.
            -- Andreas, 2020-06-17 TODO:
            -- Couldn't we return this type from checkConstructorParameters?
            Type
    cType <- (Type -> Args -> Type
    `piApply` Args
    pars) (Type -> Type) -> (Definition -> Type) -> Definition -> Type
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Definition -> Type
    defType (Definition -> Type)
    -> ExceptT TCErr (TCMT IO) Definition
    -> ExceptT TCErr (TCMT IO) Type
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ConHead -> ExceptT TCErr (TCMT IO) Definition
    forall (m :: * -> *). HasConstInfo m => ConHead -> m Definition
    getConInfo ConHead
    con

            (QName, ConHead, (Type, Maybe TCState))
    -> ExceptT TCErr (TCMT IO) (QName, ConHead, (Type, Maybe TCState))
    forall (m :: * -> *) a. Monad m => a -> m a
    return (QName
    c, ConHead
    con, (Type
    cType, Maybe TCState
    mst))

        -- This deduplication identifies different names of the same
        -- constructor, ensuring that the "ambiguous constructor" error
        -- does not fire for the case described in #4130.
        --
        -- Andreas, 2020-06-17, issue #4135:
        -- However, we need to distinguish different occurrences
        -- of the same original constructor if it is used
        -- with different data parameters, as recorded in the @Type@.
        dedupCons ::
          forall a.       [ (a, ConHead, (Type, Maybe TCState)) ]
             -> TCM [ List1 (a, ConHead, (Type, Maybe TCState)) ]
        dedupCons :: forall a.
    [(a, ConHead, (Type, Maybe TCState))]
    -> TCM [List1 (a, ConHead, (Type, Maybe TCState))]
    dedupCons [(a, ConHead, (Type, Maybe TCState))]
    cands = do
          -- Group candidates by original constructor name.
          let groups :: [List1 (a, ConHead, (Type, Maybe TCState))]
    groups = ((a, ConHead, (Type, Maybe TCState)) -> QName)
    -> [(a, ConHead, (Type, Maybe TCState))]
    -> [List1 (a, ConHead, (Type, Maybe TCState))]
    forall (f :: * -> *) b a.
    (Foldable f, Eq b) =>
    (a -> b) -> f a -> [NonEmpty a]
    List1.groupWith (ConHead -> QName
    conName (ConHead -> QName)
    -> ((a, ConHead, (Type, Maybe TCState)) -> ConHead)
    -> (a, ConHead, (Type, Maybe TCState))
    -> QName
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (a, ConHead, (Type, Maybe TCState)) -> ConHead
    forall a b c. (a, b, c) -> b
    snd3) [(a, ConHead, (Type, Maybe TCState))]
    cands
          -- Eliminate duplicates (same type) from groups.
          (List1 (a, ConHead, (Type, Maybe TCState))
     -> TCMT IO (List1 (a, ConHead, (Type, Maybe TCState))))
    -> [List1 (a, ConHead, (Type, Maybe TCState))]
    -> TCM [List1 (a, ConHead, (Type, Maybe TCState))]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM (((a, ConHead, (Type, Maybe TCState))
     -> (a, ConHead, (Type, Maybe TCState)) -> TCMT IO Bool)
    -> List1 (a, ConHead, (Type, Maybe TCState))
    -> TCMT IO (List1 (a, ConHead, (Type, Maybe TCState)))
    forall (m :: * -> *) a.
    Monad m =>
    (a -> a -> m Bool) -> List1 a -> m (List1 a)
    List1.nubM ((Type, Maybe TCState) -> (Type, Maybe TCState) -> TCMT IO Bool
    cmpM ((Type, Maybe TCState) -> (Type, Maybe TCState) -> TCMT IO Bool)
    -> ((a, ConHead, (Type, Maybe TCState)) -> (Type, Maybe TCState))
    -> (a, ConHead, (Type, Maybe TCState))
    -> (a, ConHead, (Type, Maybe TCState))
    -> TCMT IO Bool
    forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
    `on` (a, ConHead, (Type, Maybe TCState)) -> (Type, Maybe TCState)
    forall a b c. (a, b, c) -> c
    thd3)) [List1 (a, ConHead, (Type, Maybe TCState))]
    groups
          where
          -- The types come possibly with their own state.
          cmpM :: (Type, Maybe TCState) -> (Type, Maybe TCState) -> TCMT IO Bool
    cmpM (Type
    a1, Maybe TCState
    mst1) (Type
    a2, Maybe TCState
    mst2) = do
            let cmpTypes :: TCMT IO Bool
    cmpTypes = TCMT IO () -> TCMT IO Bool
    forall (m :: * -> *).
    (MonadConstraint m, MonadWarning m, MonadError TCErr m,
     MonadFresh ProblemId m) =>
    m () -> m Bool
    tryConversion (TCMT IO () -> TCMT IO Bool) -> TCMT IO () -> TCMT IO Bool
    forall a b. (a -> b) -> a -> b
    $ Type -> Type -> TCMT IO ()
    forall (m :: * -> *). MonadConversion m => Type -> Type -> m ()
    equalType Type
    a1 Type
    a2
            case (Maybe TCState
    mst1, Maybe TCState
    mst2) of
              (Maybe TCState
    Nothing, Maybe TCState
    Nothing) -> TCMT IO Bool
    cmpTypes
              (Just TCState
    st, Maybe TCState
    Nothing) -> TCState -> TCMT IO Bool -> TCMT IO Bool
    forall {a}. TCState -> TCMT IO a -> TCMT IO a
    inState TCState
    st TCMT IO Bool
    cmpTypes
              (Maybe TCState
    Nothing, Just TCState
    st) -> TCState -> TCMT IO Bool -> TCMT IO Bool
    forall {a}. TCState -> TCMT IO a -> TCMT IO a
    inState TCState
    st TCMT IO Bool
    cmpTypes
              -- Andreas, 2020-06-17, issue #4135.
              -- If the state has diverged into two states we give up.
              -- For instance, one state may say `?0 := true`
              -- and the other `?0 := false`.
              -- The types may be both `D ?0`, which is the same
              -- but diverges in the different states.
              -- We do not check states for equality.
              --
              -- Of course, this is conservative and not maximally extensional.
              -- We might throw an ambiguity error too eagerly,
              -- but this can always be worked around.
              (Just{},  Just{})  -> Bool -> TCMT IO Bool
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    False
          inState :: TCState -> TCMT IO a -> TCMT IO a
    inState TCState
    st TCMT IO a
    m = TCMT IO a -> TCMT IO a
    forall a. TCM a -> TCM a
    localTCState (TCMT IO a -> TCMT IO a) -> TCMT IO a -> TCMT IO a
    forall a b. (a -> b) -> a -> b
    $ do TCState -> TCMT IO ()
    forall (m :: * -> *). MonadTCState m => TCState -> m ()
    putTC TCState
    st; TCMT IO a
    m

    prettyDisamb :: (QName -> Maybe (Range' SrcFile)) -> QName -> TCM Doc
    prettyDisamb :: (QName -> Maybe (Range' SrcFile)) -> QName -> TCMT IO Doc
    prettyDisamb QName -> Maybe (Range' SrcFile)
    f QName
    x = do
      let d :: TCMT IO Doc
    d  = QName -> TCMT IO Doc
    forall (m :: * -> *) a. (Applicative m, Pretty a) => a -> m Doc
    pretty (QName -> TCMT IO Doc) -> TCMT IO QName -> TCMT IO Doc
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< QName -> TCMT IO QName
    dropTopLevelModule QName
    x
      Maybe (Range' SrcFile)
    -> TCMT IO Doc -> (Range' SrcFile -> TCMT IO Doc) -> TCMT IO Doc
    forall a b. Maybe a -> b -> (a -> b) -> b
    caseMaybe (QName -> Maybe (Range' SrcFile)
    f QName
    x) TCMT IO Doc
    d ((Range' SrcFile -> TCMT IO Doc) -> TCMT IO Doc)
    -> (Range' SrcFile -> TCMT IO Doc) -> TCMT IO Doc
    forall a b. (a -> b) -> a -> b
    $ \ Range' SrcFile
    r -> TCMT IO Doc
    d TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> (TCMT IO Doc
    "(introduced at " TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall a. Semigroup a => a -> a -> a
    <> Range' SrcFile -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM Range' SrcFile
    r TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall a. Semigroup a => a -> a -> a
    <> TCMT IO Doc
    ")")

    -- | For Ambiguous Projection errors, print the last range in 'qnameModule'.
    --   For Ambiguous Constructor errors, print the range in 'qnameName'. This fixes the bad
    --   error message in #4130.
    prettyDisambProj, prettyDisambCons :: QName -> TCM Doc
    prettyDisambProj :: QName -> TCMT IO Doc
    prettyDisambProj = (QName -> Maybe (Range' SrcFile)) -> QName -> TCMT IO Doc
    prettyDisamb ((QName -> Maybe (Range' SrcFile)) -> QName -> TCMT IO Doc)
    -> (QName -> Maybe (Range' SrcFile)) -> QName -> TCMT IO Doc
    forall a b. (a -> b) -> a -> b
    $ [Range' SrcFile] -> Maybe (Range' SrcFile)
    forall a. [a] -> Maybe a
    lastMaybe ([Range' SrcFile] -> Maybe (Range' SrcFile))
    -> (QName -> [Range' SrcFile]) -> QName -> Maybe (Range' SrcFile)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Range' SrcFile -> Bool) -> [Range' SrcFile] -> [Range' SrcFile]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Range' SrcFile
    forall a. Range' a
    noRange Range' SrcFile -> Range' SrcFile -> Bool
    forall a. Eq a => a -> a -> Bool
    /=) ([Range' SrcFile] -> [Range' SrcFile])
    -> (QName -> [Range' SrcFile]) -> QName -> [Range' SrcFile]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Name -> Range' SrcFile) -> [Name] -> [Range' SrcFile]
    forall a b. (a -> b) -> [a] -> [b]
    map Name -> Range' SrcFile
    nameBindingSite ([Name] -> [Range' SrcFile])
    -> (QName -> [Name]) -> QName -> [Range' SrcFile]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ModuleName -> [Name]
    mnameToList (ModuleName -> [Name]) -> (QName -> ModuleName) -> QName -> [Name]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . QName -> ModuleName
    qnameModule
    prettyDisambCons :: QName -> TCMT IO Doc
    prettyDisambCons = (QName -> Maybe (Range' SrcFile)) -> QName -> TCMT IO Doc
    prettyDisamb ((QName -> Maybe (Range' SrcFile)) -> QName -> TCMT IO Doc)
    -> (QName -> Maybe (Range' SrcFile)) -> QName -> TCMT IO Doc
    forall a b. (a -> b) -> a -> b
    $ Range' SrcFile -> Maybe (Range' SrcFile)
    forall a. a -> Maybe a
    Just (Range' SrcFile -> Maybe (Range' SrcFile))
    -> (QName -> Range' SrcFile) -> QName -> Maybe (Range' SrcFile)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Name -> Range' SrcFile
    nameBindingSite (Name -> Range' SrcFile)
    -> (QName -> Name) -> QName -> Range' SrcFile
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . QName -> Name
    qnameName

    -- | @checkConstructorParameters c d pars@ checks that the data/record type
    --   behind @c@ is has initial parameters (coming e.g. from a module instantiation)
    --   that coincide with an prefix of @pars@.
    checkConstructorParameters :: MonadTCM tcm => QName -> QName -> Args -> tcm ()
    checkConstructorParameters :: forall (tcm :: * -> *).
    MonadTCM tcm =>
    QName -> QName -> Args -> tcm ()
    checkConstructorParameters QName
    c QName
    d Args
    pars = do
      QName
    dc <- TCMT IO QName -> tcm QName
    forall (tcm :: * -> *) a. MonadTCM tcm => TCM a -> tcm a
    liftTCM (TCMT IO QName -> tcm QName) -> TCMT IO QName -> tcm QName
    forall a b. (a -> b) -> a -> b
    $ QName -> TCMT IO QName
    forall (m :: * -> *). HasConstInfo m => QName -> m QName
    getConstructorData QName
    c
      QName -> QName -> Args -> tcm ()
    forall (tcm :: * -> *).
    MonadTCM tcm =>
    QName -> QName -> Args -> tcm ()
    checkParameters QName
    dc QName
    d Args
    pars

    -- | Check that given parameters match the parameters of the inferred
    --   constructor/projection.
    checkParameters
      :: MonadTCM tcm
      => QName  -- ^ The record/data type name of the chosen constructor/projection.
      -> QName  -- ^ The record/data type name as supplied by the type signature.
      -> Args   -- ^ The parameters.
      -> tcm ()
    checkParameters :: forall (tcm :: * -> *).
    MonadTCM tcm =>
    QName -> QName -> Args -> tcm ()
    checkParameters QName
    dc QName
    d Args
    pars = TCMT IO () -> tcm ()
    forall (tcm :: * -> *) a. MonadTCM tcm => TCM a -> tcm a
    liftTCM (TCMT IO () -> tcm ()) -> TCMT IO () -> tcm ()
    forall a b. (a -> b) -> a -> b
    $ do
      Term
    a  <- Term -> TCMT IO Term
    forall a (m :: * -> *). (Reduce a, MonadReduce m) => a -> m a
    reduce (QName -> Elims -> Term
    Def QName
    dc [])
      case Term
    a of
        Def QName
    d0 Elims
    es -> do -- compare parameters
          let vs :: Args
    vs = Args -> Maybe Args -> Args
    forall a. a -> Maybe a -> a
    fromMaybe Args
    forall a. HasCallStack => a
    __IMPOSSIBLE__ (Maybe Args -> Args) -> Maybe Args -> Args
    forall a b. (a -> b) -> a -> b
    $ Elims -> Maybe Args
    forall a. [Elim' a] -> Maybe [Arg a]
    allApplyElims Elims
    es
          [Char] -> Int -> TCMT IO Doc -> TCMT IO ()
    forall (m :: * -> *).
    MonadDebug m =>
    [Char] -> Int -> TCMT IO Doc -> m ()
    reportSDoc [Char]
    "tc.lhs.split" Int
    40 (TCMT IO Doc -> TCMT IO ()) -> TCMT IO Doc -> TCMT IO ()
    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
    "checkParameters"
            , 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
    "d                   =" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> ([Char] -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => [Char] -> m Doc
    text ([Char] -> TCMT IO Doc)
    -> (QName -> [Char]) -> QName -> TCMT IO Doc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . QName -> [Char]
    forall a. Pretty a => a -> [Char]
    prettyShow) QName
    d
            , 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
    "d0 (should be == d) =" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> ([Char] -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => [Char] -> m Doc
    text ([Char] -> TCMT IO Doc)
    -> (QName -> [Char]) -> QName -> TCMT IO Doc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . QName -> [Char]
    forall a. Pretty a => a -> [Char]
    prettyShow) QName
    d0
            , 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
    "dc                  =" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> ([Char] -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => [Char] -> m Doc
    text ([Char] -> TCMT IO Doc)
    -> (QName -> [Char]) -> QName -> TCMT IO Doc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . QName -> [Char]
    forall a. Pretty a => a -> [Char]
    prettyShow) QName
    dc
            , 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
    "vs                  =" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> Args -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM Args
    vs
            , 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
    "pars                =" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> Args -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM Args
    pars
            ]
          -- when (d0 /= d) __IMPOSSIBLE__ -- d could have extra qualification
          Type
    t <- QName -> TCMT IO Type
    forall (m :: * -> *).
    (HasConstInfo m, ReadTCState m) =>
    QName -> m Type
    typeOfConst QName
    d
          [Polarity]
    -> [IsForced] -> Type -> Term -> Args -> Args -> TCMT IO ()
    forall (m :: * -> *).
    MonadConversion m =>
    [Polarity] -> [IsForced] -> Type -> Term -> Args -> Args -> m ()
    compareArgs [] [] Type
    t (QName -> Elims -> Term
    Def QName
    d []) Args
    vs (Int -> Args -> Args
    forall a. Int -> [a] -> [a]
    take (Args -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length Args
    vs) Args
    pars)
        Term
    _ -> TCMT IO ()
    forall a. HasCallStack => a
    __IMPOSSIBLE__

    checkSortOfSplitVar :: (MonadTCM m, PureTCM m, MonadError TCErr m,
                            LensSort a, PrettyTCM a, LensSort ty, PrettyTCM ty)
                        => DataOrRecord -> a -> Telescope -> Maybe ty -> m ()
    checkSortOfSplitVar :: forall (m :: * -> *) a ty.
    (MonadTCM m, PureTCM m, MonadError TCErr m, LensSort a,
     PrettyTCM a, LensSort ty, PrettyTCM ty) =>
    DataOrRecord -> a -> Tele (Dom' Term Type) -> Maybe ty -> m ()
    checkSortOfSplitVar DataOrRecord
    dr a
    a Tele (Dom' Term Type)
    tel Maybe ty
    mtarget = do
      TCM (Sort' Term) -> m (Sort' Term)
    forall (tcm :: * -> *) a. MonadTCM tcm => TCM a -> tcm a
    liftTCM (Sort' Term -> TCM (Sort' Term)
    forall a (m :: * -> *). (Reduce a, MonadReduce m) => a -> m a
    reduce (Sort' Term -> TCM (Sort' Term)) -> Sort' Term -> TCM (Sort' Term)
    forall a b. (a -> b) -> a -> b
    $ a -> Sort' Term
    forall a. LensSort a => a -> Sort' Term
    getSort a
    a) m (Sort' Term) -> (Sort' Term -> m ()) -> m ()
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \case
        sa :: Sort' Term
    sa@Type{} -> m Bool -> m () -> m ()
    forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
    whenM m Bool
    forall (m :: * -> *). HasOptions m => m Bool
    isTwoLevelEnabled m ()
    checkFibrantSplit
        Prop{} -> m ()
    checkPropSplit
        Inf IsFibrant
    IsFibrant Integer
    _ -> m Bool -> m () -> m ()
    forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
    whenM m Bool
    forall (m :: * -> *). HasOptions m => m Bool
    isTwoLevelEnabled m ()
    checkFibrantSplit
        Inf IsFibrant
    IsStrict Integer
    _ -> () -> m ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
        SSet{} -> () -> m ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
        Sort' Term
    sa      -> TypeError -> m ()
    forall (m :: * -> *) a.
    (HasCallStack, ReadTCState m, MonadError TCErr m, MonadTCEnv m) =>
    TypeError -> m a
    softTypeError (TypeError -> m ()) -> m TypeError -> m ()
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< do
          TCM TypeError -> m TypeError
    forall (tcm :: * -> *) a. MonadTCM tcm => TCM a -> tcm a
    liftTCM (TCM TypeError -> m TypeError) -> TCM TypeError -> m TypeError
    forall a b. (a -> b) -> a -> b
    $ Maybe Blocker -> Doc -> TypeError
    SortOfSplitVarError (Maybe Blocker -> Doc -> TypeError)
    -> TCMT IO (Maybe Blocker) -> TCMT IO (Doc -> TypeError)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Sort' Term -> TCMT IO (Maybe Blocker)
    forall t (m :: * -> *).
    (Reduce t, IsMeta t, MonadReduce m) =>
    t -> m (Maybe Blocker)
    isBlocked Sort' Term
    sa TCMT IO (Doc -> TypeError) -> TCMT IO Doc -> TCM TypeError
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> [TCMT IO Doc] -> TCMT IO Doc
    forall (m :: * -> *) (t :: * -> *).
    (Applicative m, Foldable t) =>
    t (m Doc) -> m Doc
    sep
            [ TCMT IO Doc
    "Cannot split on datatype in sort" , Sort' Term -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM (a -> Sort' Term
    forall a. LensSort a => a -> Sort' Term
    getSort a
    a) ]

      where
        checkPropSplit :: m ()
    checkPropSplit
          | IsRecord Maybe Induction
    Nothing EtaEquality
    _ <- DataOrRecord
    dr = () -> m ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
          | Just ty
    target <- Maybe ty
    mtarget = do
            [Char] -> Int -> TCMT IO Doc -> m ()
    forall (m :: * -> *).
    MonadDebug m =>
    [Char] -> Int -> TCMT IO Doc -> m ()
    reportSDoc [Char]
    "tc.sort.check" Int
    20 (TCMT IO Doc -> m ()) -> TCMT IO Doc -> m ()
    forall a b. (a -> b) -> a -> b
    $ TCMT IO Doc
    "target prop:" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> ty -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM ty
    target
            ty -> m ()
    checkIsProp ty
    target
          | Bool
    otherwise              = do
              [Char] -> Int -> TCMT IO Doc -> m ()
    forall (m :: * -> *).
    MonadDebug m =>
    [Char] -> Int -> TCMT IO Doc -> m ()
    reportSDoc [Char]
    "tc.sort.check" Int
    20 (TCMT IO Doc -> m ()) -> TCMT IO Doc -> m ()
    forall a b. (a -> b) -> a -> b
    $ TCMT IO Doc
    "no target prop"
              DataOrRecord -> m ()
    forall {m :: * -> *} {b}.
    (ReadTCState m, MonadError TCErr m, MonadTCM m) =>
    DataOrRecord -> m b
    splitOnPropError DataOrRecord
    dr

        checkIsProp :: ty -> m ()
    checkIsProp ty
    t = BlockT m Bool -> m (Either Blocker Bool)
    forall (m :: * -> *) a.
    Monad m =>
    BlockT m a -> m (Either Blocker a)
    runBlocked (ty -> BlockT m Bool
    forall a (m :: * -> *).
    (LensSort a, PrettyTCM a, PureTCM m, MonadBlock m) =>
    a -> m Bool
    isPropM ty
    t) m (Either Blocker Bool) -> (Either Blocker Bool -> m ()) -> m ()
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \case
          Left Blocker
    b      -> DataOrRecord -> m ()
    forall {m :: * -> *} {b}.
    (ReadTCState m, MonadError TCErr m, MonadTCM m) =>
    DataOrRecord -> m b
    splitOnPropError DataOrRecord
    dr -- TODO
          Right Bool
    False -> DataOrRecord -> m ()
    forall {m :: * -> *} {b}.
    (ReadTCState m, MonadError TCErr m, MonadTCM m) =>
    DataOrRecord -> m b
    splitOnPropError DataOrRecord
    dr
          Right Bool
    True  -> () -> m ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

        checkFibrantSplit :: m ()
    checkFibrantSplit
          | IsRecord Maybe Induction
    _ EtaEquality
    _ <- DataOrRecord
    dr     = () -> m ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
          | Just ty
    target <- Maybe ty
    mtarget = do
              [Char] -> Int -> TCMT IO Doc -> m ()
    forall (m :: * -> *).
    MonadDebug m =>
    [Char] -> Int -> TCMT IO Doc -> m ()
    reportSDoc [Char]
    "tc.sort.check" Int
    20 (TCMT IO Doc -> m ()) -> TCMT IO Doc -> m ()
    forall a b. (a -> b) -> a -> b
    $ TCMT IO Doc
    "target:" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> ty -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM ty
    target
              ty -> m ()
    checkIsFibrant ty
    target
              [Dom ([Char], Type)] -> (Dom ([Char], Type) -> m ()) -> m ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    t a -> (a -> m b) -> m ()
    forM_ (Tele (Dom' Term Type) -> [Dom ([Char], Type)]
    forall t. Tele (Dom t) -> [Dom ([Char], t)]
    telToList Tele (Dom' Term Type)
    tel) ((Dom ([Char], Type) -> m ()) -> m ())
    -> (Dom ([Char], Type) -> m ()) -> m ()
    forall a b. (a -> b) -> a -> b
    $ \ Dom ([Char], Type)
    d -> do
                let ty :: Type
    ty = ([Char], Type) -> Type
    forall a b. (a, b) -> b
    snd (([Char], Type) -> Type) -> ([Char], Type) -> Type
    forall a b. (a -> b) -> a -> b
    $ Dom ([Char], Type) -> ([Char], Type)
    forall t e. Dom' t e -> e
    unDom Dom ([Char], Type)
    d
                Type -> m ()
    checkIsCoFibrant Type
    ty
          | Bool
    otherwise              = do
              [Char] -> Int -> TCMT IO Doc -> m ()
    forall (m :: * -> *).
    MonadDebug m =>
    [Char] -> Int -> TCMT IO Doc -> m ()
    reportSDoc [Char]
    "tc.sort.check" Int
    20 (TCMT IO Doc -> m ()) -> TCMT IO Doc -> m ()
    forall a b. (a -> b) -> a -> b
    $ TCMT IO Doc
    "no target"
              Maybe Blocker -> m ()
    splitOnFibrantError Maybe Blocker
    forall a. Maybe a
    Nothing

        -- Cofibrant types are those that could be the domain of a fibrant
        -- pi type. (Notion by C. Sattler).
        checkIsCoFibrant :: Type -> m ()
    checkIsCoFibrant Type
    t = BlockT m Bool -> m (Either Blocker Bool)
    forall (m :: * -> *) a.
    Monad m =>
    BlockT m a -> m (Either Blocker a)
    runBlocked (Type -> BlockT m Bool
    forall a (m :: * -> *).
    (LensSort a, PureTCM m, MonadBlock m) =>
    a -> m Bool
    isCoFibrantSort Type
    t) m (Either Blocker Bool) -> (Either Blocker Bool -> m ()) -> m ()
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \case
          Left Blocker
    b      -> Type -> Maybe Blocker -> m ()
    splitOnFibrantError' Type
    t (Maybe Blocker -> m ()) -> Maybe Blocker -> m ()
    forall a b. (a -> b) -> a -> b
    $ Blocker -> Maybe Blocker
    forall a. a -> Maybe a
    Just Blocker
    b
          Right Bool
    False -> m Bool -> m () -> m ()
    forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
    unlessM (Type -> m Bool
    forall (m :: * -> *). (MonadTCM m, MonadReduce m) => Type -> m Bool
    isInterval Type
    t) (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $
                           Type -> Maybe Blocker -> m ()
    splitOnFibrantError' Type
    t (Maybe Blocker -> m ()) -> Maybe Blocker -> m ()
    forall a b. (a -> b) -> a -> b
    $ Maybe Blocker
    forall a. Maybe a
    Nothing
          Right Bool
    True  -> () -> m ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

        checkIsFibrant :: ty -> m ()
    checkIsFibrant ty
    t = BlockT m Bool -> m (Either Blocker Bool)
    forall (m :: * -> *) a.
    Monad m =>
    BlockT m a -> m (Either Blocker a)
    runBlocked (ty -> BlockT m Bool
    forall a (m :: * -> *).
    (LensSort a, PureTCM m, MonadBlock m) =>
    a -> m Bool
    isFibrant ty
    t) m (Either Blocker Bool) -> (Either Blocker Bool -> m ()) -> m ()
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \case
          Left Blocker
    b      -> Maybe Blocker -> m ()
    splitOnFibrantError (Maybe Blocker -> m ()) -> Maybe Blocker -> m ()
    forall a b. (a -> b) -> a -> b
    $ Blocker -> Maybe Blocker
    forall a. a -> Maybe a
    Just Blocker
    b
          Right Bool
    False -> Maybe Blocker -> m ()
    splitOnFibrantError Maybe Blocker
    forall a. Maybe a
    Nothing
          Right Bool
    True  -> () -> m ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

        splitOnPropError :: DataOrRecord -> m b
    splitOnPropError DataOrRecord
    dr = TypeError -> m b
    forall (m :: * -> *) a.
    (HasCallStack, ReadTCState m, MonadError TCErr m, MonadTCEnv m) =>
    TypeError -> m a
    softTypeError (TypeError -> m b) -> m TypeError -> m b
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< do
          TCM TypeError -> m TypeError
    forall (tcm :: * -> *) a. MonadTCM tcm => TCM a -> tcm a
    liftTCM (TCM TypeError -> m TypeError) -> TCM TypeError -> m TypeError
    forall a b. (a -> b) -> a -> b
    $ Doc -> TypeError
    GenericDocError (Doc -> TypeError) -> TCMT IO Doc -> TCM TypeError
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$>
            (TCMT IO Doc
    "Cannot split on" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> DataOrRecord -> TCMT IO Doc
    kindOfData DataOrRecord
    dr TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> TCMT IO Doc
    "in Prop unless target is in Prop")
          where
            kindOfData :: DataOrRecord -> TCM Doc
            kindOfData :: DataOrRecord -> TCMT IO Doc
    kindOfData DataOrRecord
    IsData                          = TCMT IO Doc
    "datatype"
            kindOfData (IsRecord Maybe Induction
    Nothing EtaEquality
    _)            = TCMT IO Doc
    "record type"
            kindOfData (IsRecord (Just Induction
    Inductive) EtaEquality
    _)   = TCMT IO Doc
    "inductive record type"
            kindOfData (IsRecord (Just Induction
    CoInductive) EtaEquality
    _) = TCMT IO Doc
    "coinductive record type"

        splitOnFibrantError' :: Type -> Maybe Blocker -> m ()
    splitOnFibrantError' Type
    t Maybe Blocker
    mb = TypeError -> m ()
    forall (m :: * -> *) a.
    (HasCallStack, ReadTCState m, MonadError TCErr m, MonadTCEnv m) =>
    TypeError -> m a
    softTypeError (TypeError -> m ()) -> m TypeError -> m ()
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< do
          TCM TypeError -> m TypeError
    forall (tcm :: * -> *) a. MonadTCM tcm => TCM a -> tcm a
    liftTCM (TCM TypeError -> m TypeError) -> TCM TypeError -> m TypeError
    forall a b. (a -> b) -> a -> b
    $ Maybe Blocker -> Doc -> TypeError
    SortOfSplitVarError Maybe Blocker
    mb (Doc -> TypeError) -> TCMT IO Doc -> TCM TypeError
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [TCMT IO Doc] -> TCMT IO Doc
    forall (m :: * -> *) (t :: * -> *).
    (Applicative m, Foldable t) =>
    t (m Doc) -> m Doc
    fsep
            [ TCMT IO Doc
    "Cannot eliminate fibrant type" , a -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM a
    a
            , TCMT IO Doc
    "unless context type", Type -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM Type
    t, TCMT IO Doc
    "is also fibrant."
            ]

        splitOnFibrantError :: Maybe Blocker -> m ()
    splitOnFibrantError Maybe Blocker
    mb = TypeError -> m ()
    forall (m :: * -> *) a.
    (HasCallStack, ReadTCState m, MonadError TCErr m, MonadTCEnv m) =>
    TypeError -> m a
    softTypeError (TypeError -> m ()) -> m TypeError -> m ()
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< do
          TCM TypeError -> m TypeError
    forall (tcm :: * -> *) a. MonadTCM tcm => TCM a -> tcm a
    liftTCM (TCM TypeError -> m TypeError) -> TCM TypeError -> m TypeError
    forall a b. (a -> b) -> a -> b
    $ Maybe Blocker -> Doc -> TypeError
    SortOfSplitVarError Maybe Blocker
    mb (Doc -> TypeError) -> TCMT IO Doc -> TCM TypeError
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [TCMT IO Doc] -> TCMT IO Doc
    forall (m :: * -> *) (t :: * -> *).
    (Applicative m, Foldable t) =>
    t (m Doc) -> m Doc
    fsep
            [ TCMT IO Doc
    "Cannot eliminate fibrant type" , a -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM a
    a
            , TCMT IO Doc
    "unless target type is also fibrant"
            ]