    {-# 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)
    import Control.Monad.Except       ( MonadError(..), ExceptT(..), runExceptT )
    import Control.Monad.Reader       ( MonadReader(..), asks, runReaderT )
    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 qualified 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.Sort
    import Agda.TypeChecking.Substitute
    import Agda.TypeChecking.Telescope
    import Agda.TypeChecking.Telescope.Path
    import Agda.TypeChecking.Primitive hiding (Nat)
    import Agda.TypeChecking.Warnings (warning)

    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.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 Agda.Utils.List2 (pattern List2)
    import qualified Agda.Utils.List1 as List1
    import qualified Agda.Utils.List2 as List2
    import Agda.Utils.Maybe
    import Agda.Utils.Monad
    import Agda.Utils.Null
    import qualified Agda.Syntax.Common.Pretty as P
    import Agda.Syntax.Common.Pretty (prettyShow)
    import Agda.Utils.Singleton
    import Agda.Utils.Size
    import Agda.Utils.Tuple

    import Agda.Utils.Impossible
    import Agda.TypeChecking.Free (freeIn)

    -- | Extra read-only state for the LHS checker.
    --
    data LHSContext = LHSContext
      { LHSContext -> Range
    lhsRange       :: Range  -- ^ The range of the whole lhs of a clause.
      , LHSContext -> Int
    lhsContextSize :: Nat    -- ^ Original size of the context in which the lhs checker runs.
      }

    -- | 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
    forall (m :: * -> *).
    (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 a. a -> MaybeT m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return FlexibleVarKind
    DotFlex
          A.VarP{}  -> FlexibleVarKind -> MaybeT m FlexibleVarKind
    forall a. a -> MaybeT m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return FlexibleVarKind
    ImplicitFlex
          A.WildP{} -> FlexibleVarKind -> MaybeT m FlexibleVarKind
    forall a. a -> MaybeT m a
    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
    forall (m :: * -> *).
    (HasConstInfo m, MonadDebug m) =>
    Pattern -> 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, RecordData) -> Bool
    forall a. Maybe a -> Bool
    isNothing (Maybe (QName, RecordData) -> Bool)
    -> MaybeT m (Maybe (QName, RecordData)) -> MaybeT m Bool
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> QName -> MaybeT m (Maybe (QName, RecordData))
    forall (m :: * -> *).
    HasConstInfo m =>
    QName -> m (Maybe (QName, RecordData))
    isRecordConstructor QName
    c) (FlexibleVarKind -> MaybeT m FlexibleVarKind
    forall a. a -> MaybeT m a
    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
    forall (m :: * -> *).
    (HasConstInfo m, MonadDebug m) =>
    [NamedArg Pattern] -> MaybeT m FlexibleVarKind
    maybeFlexiblePattern [NamedArg Pattern]
    qs)
          A.LitP{}  -> FlexibleVarKind -> MaybeT m FlexibleVarKind
    forall a. a -> MaybeT m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return FlexibleVarKind
    OtherFlex
          Pattern
    _ -> MaybeT m FlexibleVarKind
    forall a. MaybeT m a
    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 a. a -> MaybeT m a
    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 a. a -> MaybeT m a
    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
    forall (m :: * -> *).
    (HasConstInfo m, MonadDebug m) =>
    [NamedArg (Pattern' a)] -> MaybeT m FlexibleVarKind
    maybeFlexiblePattern [NamedArg (Pattern' a)]
    ps
            | Bool
    otherwise -> MaybeT m FlexibleVarKind
    forall a. MaybeT m a
    forall (m :: * -> *) a. MonadPlus m => m a
    mzero
          I.VarP{}  -> MaybeT m FlexibleVarKind
    forall a. MaybeT m a
    forall (m :: * -> *) a. MonadPlus m => m a
    mzero
          I.LitP{}  -> MaybeT m FlexibleVarKind
    forall a. MaybeT m a
    forall (m :: * -> *) a. MonadPlus m => m a
    mzero
          I.ProjP{} -> MaybeT m FlexibleVarKind
    forall a. MaybeT m a
    forall (m :: * -> *) a. MonadPlus m => m a
    mzero
          I.IApplyP{} -> MaybeT m FlexibleVarKind
    forall a. MaybeT m a
    forall (m :: * -> *) a. MonadPlus m => m a
    mzero
          I.DefP{} -> MaybeT m FlexibleVarKind
    forall a. MaybeT m a
    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)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM a -> MaybeT m FlexibleVarKind
    forall a (m :: * -> *).
    (IsFlexiblePattern a, HasConstInfo m, MonadDebug m) =>
    a -> MaybeT m FlexibleVarKind
    forall (m :: * -> *).
    (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
    forall (m :: * -> *).
    (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
    forall (m :: * -> *).
    (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 :: Telescope
    tel     = LHSState a
    st LHSState a -> Lens' (LHSState a) Telescope -> Telescope
    forall o i. o -> Lens' o i -> i
    ^. (Telescope -> f Telescope) -> LHSState a -> f (LHSState a)
    forall a (f :: * -> *).
    Functor f =>
    (Telescope -> f Telescope) -> LHSState a -> f (LHSState a)
    Lens' (LHSState a) Telescope
    lhsTel
          problem :: Problem a
    problem = LHSState a
    st LHSState a -> Lens' (LHSState a) (Problem a) -> Problem a
    forall o i. o -> Lens' o i -> i
    ^. (Problem a -> f (Problem a)) -> LHSState a -> f (LHSState a)
    forall a (f :: * -> *).
    Functor f =>
    (Problem a -> f (Problem a)) -> LHSState a -> f (LHSState a)
    Lens' (LHSState a) (Problem a)
    lhsProblem
      eqs' <- Telescope -> TCMT IO [ProblemEq] -> TCMT IO [ProblemEq]
    forall b (m :: * -> *) a.
    (AddContext b, MonadAddContext m) =>
    b -> m a -> m a
    forall (m :: * -> *) a.
    MonadAddContext m =>
    Telescope -> m a -> m a
    addContext Telescope
    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' (Problem a) [ProblemEq] -> [ProblemEq]
    forall o i. o -> Lens' o i -> i
    ^. ([ProblemEq] -> f [ProblemEq]) -> Problem a -> f (Problem a)
    forall a (f :: * -> *).
    Functor f =>
    ([ProblemEq] -> f [ProblemEq]) -> Problem a -> f (Problem a)
    Lens' (Problem a) [ProblemEq]
    problemEqs
      tel' <- useNamesFromProblemEqs eqs' tel
      updateProblemRest $ set lhsTel tel' $ set (lhsProblem . problemEqs) eqs' 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
    forall (m :: * -> *). MonadPretty m => ProblemEq -> m Doc
    prettyTCM [ProblemEq]
    eqs
        ]

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

      reportSDoc "tc.lhs.top" 20 $ vcat
        [ "updateProblem: new equations"
        , nest 2 $ if null eqs' then "(none)" else vcat $ map prettyTCM eqs'
        ]

      return 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)
    forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> [a] -> f [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 Type
    _) = [ProblemEq] -> TCMT IO [ProblemEq]
    forall a. a -> TCMT IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [ProblemEq
    eq]
        update eq :: ProblemEq
    eq@(ProblemEq p :: Pattern
    p@A.ProjP{} Term
    _ Dom 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
    IllformedProjectionPatternAbstract Pattern
    p
        update eq :: ProblemEq
    eq@(ProblemEq p :: Pattern
    p@(A.AsP PatInfo
    info BindName
    x Pattern
    p') Term
    v Dom Type
    a) =
          (Pattern -> Term -> Dom Type -> ProblemEq
    ProblemEq (BindName -> Pattern
    forall e. BindName -> Pattern' e
    A.VarP BindName
    x) Term
    v Dom 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 Type -> ProblemEq
    ProblemEq Pattern
    p' Term
    v Dom Type
    a)

        update eq :: ProblemEq
    eq@(ProblemEq Pattern
    p Term
    v Dom 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 a b. TCMT IO a -> (a -> TCMT IO b) -> TCMT IO b
    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 a b. TCMT IO a -> (a -> TCMT IO b) -> TCMT IO b
    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
            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 Type -> Type
    forall t e. Dom' t e -> e
    unDom Dom Type
    a)
            caseMaybe contype (return [eq]) $ \((QName
    d,Type
    _,Args
    pars),Type
    b) -> do
            TelV ctel _ <- 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 -> Modality
    composeModality (Dom Type -> Modality
    forall a. LensModality a => a -> Modality
    getModality Dom Type
    a)
            ctel <- return $ mapModality updMod <$> ctel

            let bs = Telescope -> [Term] -> [Dom Type]
    instTel Telescope
    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)

            p <- expandLitPattern p
            case p of
              A.AsP{} -> TCMT IO [ProblemEq]
    forall a. HasCallStack => a
    __IMPOSSIBLE__
              A.ConP ConPatInfo
    cpi AmbiguousQName
    ambC [NamedArg Pattern]
    ps -> do
                (c',_) <- 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 conName c /= conName c' then return [eq] else do

                -- Insert implicit patterns
                ps <- insertImplicitPatterns ExpandLast ps ctel
                reportSDoc "tc.lhs.imp" 20 $
                  "insertImplicitPatternsT returned" <+> fsep (map prettyA ps)

                -- Check argument count and hiding (not just count: #3074)
                let checkArgs [] [] Int
    _ Int
    _ = () -> TCMT IO ()
    forall a. a -> TCMT IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
                    checkArgs (NamedArg Pattern
    p : [NamedArg Pattern]
    ps) (Arg Term
    v : Args
    vs) Int
    nExpected Int
    nActual
                      | 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 -> Int -> Int -> TCMT IO ()
    checkArgs [NamedArg Pattern]
    ps Args
    vs (Int
    nExpected Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1) (Int
    nActual Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1)
                      | 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
    $ TypeError -> TCMT IO ()
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCError m) =>
    TypeError -> m a
    typeError TypeError
    WrongHidingInLHS
                    checkArgs [] Args
    vs Int
    nExpected Int
    nActual = 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
    $
                      QName -> Int -> Int -> TypeError
    WrongNumberOfConstructorArguments (ConHead -> QName
    conName ConHead
    c) (Int
    nExpected Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Args -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length Args
    vs) Int
    nActual
                    checkArgs (NamedArg Pattern
    p : [NamedArg Pattern]
    ps) [] Int
    nExpected Int
    nActual = 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
    $ 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
    $
                      QName -> Int -> Int -> TypeError
    WrongNumberOfConstructorArguments (ConHead -> QName
    conName ConHead
    c) Int
    nExpected (Int
    nActual Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + ([NamedArg Pattern] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [NamedArg Pattern]
    ps))

                checkArgs ps vs 0 0

                updates $ zipWith3 ProblemEq (map namedArg ps) (map unArg vs) bs

              A.RecP KwRange
    _ ConPatInfo
    _ [FieldAssignment' Pattern]
    fs -> do
                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.
                disambiguateRecordFields (map _nameFieldA fs) (map unArg axs)

                let cxs = (Arg QName -> Arg Name) -> [Arg QName] -> [Arg Name]
    forall a b. (a -> b) -> [a] -> [b]
    map ((QName -> Name) -> Arg QName -> Arg Name
    forall a b. (a -> b) -> Arg a -> Arg b
    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.
                ps <- insertMissingFieldsFail d (const $ A.WildP empty) fs cxs

                -- We also need to insert missing implicit or instance fields.
                ps <- insertImplicitPatterns ExpandLast ps ctel

                let eqs = (Pattern -> Term -> Dom Type -> ProblemEq)
    -> [Pattern] -> [Term] -> [Dom Type] -> [ProblemEq]
    forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
    zipWith3 Pattern -> Term -> Dom 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 Type]
    bs
                updates eqs

              Pattern
    _ -> [ProblemEq] -> TCMT IO [ProblemEq]
    forall a. a -> TCMT IO a
    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 a. a -> TCMT IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return []

          Term
    _ | A.EqualP{} <- Pattern
    p -> do
            itisone <- TCMT IO Term -> TCMT IO Term
    forall a. TCM a -> TCM a
    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
            ifM (tryConversion $ equalTerm (unDom a) v itisone) (return []) (return [eq])

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

        instTel :: Telescope -> [Term] -> [Dom Type]
        instTel :: Telescope -> [Term] -> [Dom Type]
    instTel Telescope
    EmptyTel [Term]
    _                   = []
        instTel (ExtendTel Dom Type
    arg Abs Telescope
    tel) (Term
    u : [Term]
    us) = Dom Type
    arg Dom Type -> [Dom Type] -> [Dom Type]
    forall a. a -> [a] -> [a]
    : Telescope -> [Term] -> [Dom Type]
    instTel (Abs Telescope -> SubstArg Telescope -> Telescope
    forall a. Subst a => Abs a -> SubstArg a -> a
    absApp Abs Telescope
    tel Term
    SubstArg Telescope
    u) [Term]
    us
        instTel ExtendTel{} []               = [Dom 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' (Problem a) [NamedArg Pattern] -> [NamedArg Pattern]
    forall o i. o -> Lens' o i -> i
    ^. ([NamedArg Pattern] -> f [NamedArg Pattern])
    -> Problem a -> f (Problem a)
    forall a (f :: * -> *).
    Functor f =>
    ([NamedArg Pattern] -> f [NamedArg Pattern])
    -> Problem a -> f (Problem a)
    Lens' (Problem a) [NamedArg Pattern]
    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' (Problem a) [NamedArg Pattern] -> [NamedArg Pattern]
    forall o i. o -> Lens' o i -> i
    ^. ([NamedArg Pattern] -> f [NamedArg Pattern])
    -> Problem a -> f (Problem a)
    forall a (f :: * -> *).
    Functor f =>
    ([NamedArg Pattern] -> f [NamedArg Pattern])
    -> Problem a -> f (Problem a)
    Lens' (Problem a) [NamedArg Pattern]
    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
        -- 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 a. a -> TCMT IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
       A.AbsurdP     {} -> () -> TCMT IO ()
    forall a. a -> TCMT IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
       A.DotP        {} -> () -> TCMT IO ()
    forall a. a -> TCMT IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
       A.EqualP      {} -> () -> TCMT IO ()
    forall a. a -> TCMT IO a
    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 = 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 b (m :: * -> *). (IsBool b, Monad m) => b -> m () -> m ()
    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
    forall (m :: * -> *). MonadPretty m => Term -> 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 -> [Char]) -> Range -> TCMT IO Doc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Range -> [Char]
    forall a. Show a => a -> [Char]
    show) (Name -> Range
    forall a. HasRange a => a -> Range
    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

        -- Get a conflicting data or record constructor, if any.
        mc <- MaybeT (TCMT IO) QName -> TCMT IO (Maybe QName)
    forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
    runMaybeT do

          -- Is the type of the pattern variable a data or pattern record type?
          a  <- TCMT IO Term -> MaybeT (TCMT IO) Term
    forall (m :: * -> *) a. Monad m => m a -> MaybeT m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (TCMT IO Term -> MaybeT (TCMT IO) Term)
    -> TCMT IO Term -> MaybeT (TCMT IO) Term
    forall a b. (a -> b) -> a -> b
    $ Term -> TCMT IO Term
    forall a (m :: * -> *). (Reduce a, MonadReduce m) => a -> m a
    reduce Term
    a
          (d, dr) <- MaybeT $ isDataOrRecord a
          guard $ patternMatchingAllowed dr

          -- Look for a constructor with the same name as the pattern variable.
          cs <- lift $ getConstructors d
          MaybeT $ pure $ List.find ((A.nameConcrete x ==) . A.nameConcrete . A.qnameName) cs

        -- Alert if there is a constructor of the same name.
        whenJust mc \ QName
    c -> 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
    $
          Warning -> TCMT IO ()
    forall (m :: * -> *).
    (HasCallStack, MonadWarning m) =>
    Warning -> m ()
    warning (Warning -> TCMT IO ()) -> Warning -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ Name -> QName -> Warning
    PatternShadowsConstructor (Name -> Name
    nameConcrete Name
    x) QName
    c
        --
        -- Andreas, 2023-09-08, issue #6829:
        -- I rewrote the code originally dating from 2009, commit:
        -- https://github.com/agda/agda/commit/5d5095ba080b04f16867d4ed5af4ba7091f1a773
        -- The code survived for almost 15 years, but it slept through the advent
        -- of matchable record constructors in 2010 (Agda 2.2.8):
        -- https://github.com/agda/agda/blob/283730b392d7c21c54b53b0f486802ec143e4af7/doc/release-notes/2.2.8.md#L7-L9
        -- Here are comments on the last version of the code I'd like to preserve,
        -- as they reflect some considerations and design decisions:
        --
                -- 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.
              -- TODO: in the future some stuck primitives might allow constructors
          -- 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.

    -- | 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 a. Call -> TCMT IO a -> TCMT IO a
    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
    forall (m :: * -> *). MonadPretty m => Term -> 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
    forall (m :: * -> *). MonadPretty m => Type -> 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
        u <- Expr -> Type -> TCMT IO Term
    checkExpr Expr
    e Type
    a
        reportSDoc "tc.lhs.dot" 50 $
          sep [ "equalTerm"
              , nest 2 $ pretty a
              , nest 2 $ pretty u
              , nest 2 $ pretty v
              ]
        equalTerm a u v

    checkAbsurdPattern :: AbsurdPattern -> TCM ()
    checkAbsurdPattern :: AbsurdPattern -> TCMT IO ()
    checkAbsurdPattern (Absurd Range
    r Type
    a) = Range -> Type -> TCMT IO ()
    ensureEmptyType Range
    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
    forall (m :: * -> *). MonadPretty m => Type -> m Doc
    prettyTCM Type
    a
            ]
      b <- Expr -> TCMT IO Type
    isType_ Expr
    t
      equalType a 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 a. a -> TCMT IO a
    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
              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 (NameOf (NamedArg DeBruijnPattern))
     -> Maybe (NameOf (NamedArg DeBruijnPattern)))
    -> (NamedName
        -> Maybe (NameOf (NamedArg DeBruijnPattern))
        -> Maybe (NameOf (NamedArg DeBruijnPattern)))
    -> Maybe NamedName
    -> Maybe (NameOf (NamedArg DeBruijnPattern))
    -> Maybe (NameOf (NamedArg DeBruijnPattern))
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Maybe (NameOf (NamedArg DeBruijnPattern))
    -> Maybe (NameOf (NamedArg DeBruijnPattern))
    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 (NameOf (NamedArg DeBruijnPattern))
     -> Maybe (NameOf (NamedArg DeBruijnPattern)))
    -> Maybe NamedName
    -> Maybe (NameOf (NamedArg DeBruijnPattern))
    -> Maybe (NameOf (NamedArg DeBruijnPattern))
    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)
    forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> Arg a -> f (Arg 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)
    forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> Named NamedName a -> f (Named NamedName 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
              (q' :) <$> transfers ps 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], Pattern)
    asView Pattern
    p , DeBruijnPattern
    q) of

          (([Name]
    asB , 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 , A.RecP KwRange
    _kwr ConPatInfo
    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
            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
    forall a. Null a => a
    empty) [FieldAssignment' Pattern]
    fs [Arg Name]
    axs
            ConP c cpi <$> transfers ps qs

          (([Name]
    asB , 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 a. a -> TCMT IO a
    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 , Pattern
    p) , VarP PatternInfo
    _ DBPatVar
    x) -> DeBruijnPattern -> TCMT IO DeBruijnPattern
    forall a. a -> TCMT IO a
    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 , Pattern
    p) , DotP PatternInfo
    _ Term
    u) -> DeBruijnPattern -> TCMT IO DeBruijnPattern
    forall a. a -> TCMT IO a
    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 , Pattern
    p) , LitP PatternInfo
    _ Literal
    l) -> DeBruijnPattern -> TCMT IO DeBruijnPattern
    forall a. a -> TCMT IO a
    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], Pattern), DeBruijnPattern)
    _ -> DeBruijnPattern -> TCMT IO DeBruijnPattern
    forall a. a -> TCMT IO a
    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__

        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 a. a -> TCMT IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return []
        check Map BindName (Term, Type)
    vars (eq :: ProblemEq
    eq@(ProblemEq Pattern
    p Term
    u Dom 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
    forall (m :: * -> *). MonadPretty m => Term -> m Doc
    prettyTCM Term
    u
            , TCMT IO Doc
    " of type "
            , Dom Type -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    forall (m :: * -> *). MonadPretty m => Dom Type -> m Doc
    prettyTCM Dom 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 a. Call -> TCMT IO a -> TCMT IO a
    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 Type -> Type
    forall t e. Dom' t e -> e
    unDom Dom Type
    a) Type
    b
                  Call -> TCMT IO () -> TCMT IO ()
    forall a. Call -> TCMT IO a -> TCMT IO a
    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 Type -> Type
    forall t e. Dom' t e -> e
    unDom Dom 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 Type -> Type
    forall t e. Dom' t e -> e
    unDom Dom 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 Type -> ProblemEq
    ProblemEq (BindName -> Pattern
    forall e. BindName -> Pattern' e
    A.VarP BindName
    x) Term
    u Dom Type
    a, Pattern -> Term -> Dom Type -> ProblemEq
    ProblemEq Pattern
    p Term
    u Dom 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] -> Telescope -> TCM Context
    computeLHSContext = Context -> [Name] -> [Maybe Name] -> Telescope -> TCM Context
    forall {m :: * -> *}.
    (MonadDebug m, MonadFresh NameId m) =>
    Context -> [Name] -> [Maybe Name] -> Telescope -> m Context
    go [] []
      where
        go :: Context -> [Name] -> [Maybe Name] -> Telescope -> m Context
    go Context
    cxt [Name]
    _ []        tel :: Telescope
    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
    <+> Telescope -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    forall (m :: * -> *). MonadPretty m => Telescope -> m Doc
    prettyTCM Telescope
    tel
          m Context
    forall a. HasCallStack => a
    __IMPOSSIBLE__
        go Context
    cxt [Name]
    _ (Maybe Name
    _ : [Maybe Name]
    _)   Telescope
    EmptyTel = m Context
    forall a. HasCallStack => a
    __IMPOSSIBLE__
        go Context
    cxt [Name]
    _ []        Telescope
    EmptyTel = Context -> m Context
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Context
    cxt
        go Context
    cxt [Name]
    taken (Maybe Name
    x : [Maybe Name]
    xs) tel0 :: Telescope
    tel0@(ExtendTel Dom Type
    a Abs Telescope
    tel) = do
            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 Telescope -> [Char]
    forall a. Abs a -> [Char]
    absName Abs Telescope
    tel) Name -> m Name
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe Name
    x
            let e = Name -> Dom Type -> ContextEntry
    CtxVar Name
    name Dom Type
    a
            go (e : cxt) (name : taken) xs (absBody 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
    forall (m :: * -> *). MonadFresh NameId m => [Char] -> 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 Dom Type
    a : [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
    forall (m :: * -> *). MonadPretty m => Name -> 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
    <+> Dom Type -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    forall (m :: * -> *). MonadPretty m => Dom Type -> m Doc
    prettyTCM Dom 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
    forall (m :: * -> *). MonadPretty m => Term -> m Doc
    prettyTCM Term
    v
            ]
      Origin -> Name -> Term -> Dom Type -> TCM a -> TCM a
    forall a.
    Origin -> Name -> Term -> Dom Type -> TCMT IO a -> TCMT IO a
    forall (m :: * -> *) a.
    MonadAddContext m =>
    Origin -> Name -> Term -> Dom Type -> m a -> m a
    addLetBinding' Origin
    Inserted Name
    x Term
    v Dom 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 Type
    a)
      | A.WildP{} <- Pattern
    p = () -> TCMT IO ()
    forall a. a -> TCMT IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
      | Bool
    otherwise      = Term -> Comparison -> TypeOf Term -> TCMT IO ()
    forall a (m :: * -> *).
    (CheckInternal a, MonadCheckInternal m) =>
    a -> Comparison -> TypeOf a -> m ()
    forall (m :: * -> *).
    MonadCheckInternal m =>
    Term -> Comparison -> TypeOf Term -> m ()
    checkInternal Term
    v Comparison
    CmpLeq (Dom Type -> Type
    forall t e. Dom' t e -> e
    unDom Dom Type
    a)
          TCMT IO () -> (TCErr -> TCMT IO ()) -> TCMT IO ()
    forall a. TCMT IO a -> (TCErr -> TCMT IO a) -> TCMT IO a
    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 ()) -> TypeError -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ Pattern -> TypeError
    IllTypedPatternAfterWithAbstraction Pattern
    p

    -- | 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 -> Telescope
    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?
      , LHSResult -> Bool
    lhsIndexedSplit :: Bool
        -- ^ have we split on an indexed type?
      }

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

    -- | 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'.
      -> Range
         -- ^ 'Range' of the entire left hand side, for error reporting.
      -> 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
    -> Range
    -> Maybe QName
    -> [NamedArg Pattern]
    -> Type
    -> Maybe Substitution
    -> [ProblemEq]
    -> (LHSResult -> TCM a)
    -> TCM a
    checkLeftHandSide Call
    call Range
    lhsRng 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 a b.
    Call
    -> ((a -> TCMT IO b) -> TCMT IO b) -> (a -> TCMT IO b) -> TCMT IO b
    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.
      cxt <- (ContextEntry -> ContextEntry) -> Context -> Context
    forall a b. (a -> b) -> [a] -> [b]
    map (Origin -> ContextEntry -> ContextEntry
    forall a. LensOrigin a => Origin -> a -> a
    setOrigin Origin
    Inserted) (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 = Context -> Telescope
    contextToTel Context
    cxt
          cps = [ Dom' Term Name -> Arg Name
    forall t a. Dom' t a -> Arg a
    argFromDom Dom' Term Name
    dom Arg Name -> Named NamedName Pattern -> NamedArg Pattern
    forall (f :: * -> *) a b. Functor f => f a -> b -> f b
    $> Pattern -> Named NamedName Pattern
    forall a name. a -> Named name a
    unnamed (BindName -> Pattern
    forall e. BindName -> Pattern' e
    A.VarP (BindName -> Pattern) -> BindName -> Pattern
    forall a b. (a -> b) -> a -> b
    $ Name -> BindName
    A.mkBindName (Name -> BindName) -> Name -> BindName
    forall a b. (a -> b) -> a -> b
    $ Dom' Term Name -> Name
    forall t e. Dom' t e -> e
    unDom Dom' Term Name
    dom)
                | (Int
    _,Dom' Term Name
    dom) <- Context -> [(Int, Dom' Term Name)]
    contextVars Context
    cxt ]
          eqs0 = (Pattern -> Term -> Dom Type -> ProblemEq)
    -> [Pattern] -> [Term] -> [Dom Type] -> [ProblemEq]
    forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
    zipWith3 Pattern -> Term -> Dom 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
    $ Telescope -> Int
    forall a. Sized a => a -> Int
    size Telescope
    tel) (Telescope -> [Dom Type]
    forall a. TermSubst a => Tele (Dom a) -> [Dom a]
    flattenTel Telescope
    tel)

      let finalChecks :: LHSState a -> TCM a
          finalChecks (LHSState Telescope
    delta [NamedArg DeBruijnPattern]
    qs0 (Problem [ProblemEq]
    eqs [NamedArg Pattern]
    rps LHSState a -> TCMT IO a
    _) Arg Type
    b [Maybe Int]
    psplit Bool
    ixsplit) = 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
    4 (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 Telescope -> TCMT IO Doc -> TCMT IO Doc
    forall b (m :: * -> *) a.
    (AddContext b, MonadAddContext m) =>
    b -> m a -> m a
    forall (m :: * -> *) a.
    MonadAddContext m =>
    Telescope -> m a -> m a
    addContext Telescope
    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
    forall (m :: * -> *). MonadPretty m => ProblemEq -> m Doc
    prettyTCM [ProblemEq]
    eqs
              , 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
    "qs0 =" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> Telescope -> TCMT IO Doc -> TCMT IO Doc
    forall b (m :: * -> *) a.
    (AddContext b, MonadAddContext m) =>
    b -> m a -> m a
    forall (m :: * -> *) a.
    MonadAddContext m =>
    Telescope -> m a -> m a
    addContext Telescope
    delta ([NamedArg DeBruijnPattern] -> TCMT IO Doc
    forall (m :: * -> *).
    MonadPretty m =>
    [NamedArg DeBruijnPattern] -> m Doc
    prettyTCMPatternList [NamedArg DeBruijnPattern]
    qs0)
              ]

            Bool -> TCMT IO () -> TCMT IO ()
    forall b (m :: * -> *). (IsBool b, Monad m) => b -> m () -> m ()
    unless ([NamedArg Pattern] -> Bool
    forall a. Null a => a -> Bool
    null [NamedArg Pattern]
    rps) TCMT IO ()
    forall a. HasCallStack => a
    __IMPOSSIBLE__

            Telescope -> TCMT IO () -> TCMT IO ()
    forall b (m :: * -> *) a.
    (AddContext b, MonadAddContext m) =>
    b -> m a -> m a
    forall (m :: * -> *) a.
    MonadAddContext m =>
    Telescope -> m a -> m a
    addContext Telescope
    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

              -- When working --without-K or --cubical-compatible, we have
              -- to check that the target type can be used at the “ambient”
              -- modality. For --cubical-compatible, this just improves an
              -- error message (printing the type rather than the generated
              -- RHS). For --without-K, it implements the same check without
              -- necessarily generating --cubical code.
              -- The reason for this check is that a clause
              --    foo : x ≡ y → ... → T y
              --    foo refl ... = ...
              -- in Cubical mode, gets elaborated to an extra clause of the
              -- form
              --    foo (transp p φ x) ... = transp (λ i → T (p i)) φ (foo x ...)
              -- (approximately), where T is the target type. That is: to
              -- implement the substitution T[y/x], we use an actual
              -- transport. See #5448.

            arity_a <- Type -> TCM Int
    arityPiPath Type
    a

            reportSDoc "tc.lhs.top" 30 $ vcat
              [ nest 2 $ "a        =" <+> prettyTCM a
              , nest 2 $ "arity_a  =" <+> prettyTCM arity_a
              , nest 2 $ "withSub' =" <+> prettyTCM withSub'
              ]

            -- Compute substitution from the out patterns @qs0@
            let notProj ProjP{} = Bool
    False
                notProj Pattern' x
    _       = Bool
    True
                numPats  = [NamedArg DeBruijnPattern] -> Int
    forall a. [a] -> 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 | 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 a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length Context
    cxt) Substitution
    forall a. Substitution' a
    idS
                withSub  = Substitution -> Maybe Substitution -> Substitution
    forall a. a -> Maybe a -> a
    fromMaybe Substitution
    forall a. Substitution' a
    idS Maybe Substitution
    withSub'
                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
    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

            eqs <- addContext delta $ checkPatternLinearity eqs

            leftovers@(LeftoverPatterns patVars asb0 dots absurds annps otherPats)
              <- addContext delta $ getLeftoverPatterns eqs

            reportSDoc "tc.lhs.leftover" 30 $ vcat
              [ "leftover patterns: " , nest 2 (addContext delta $ prettyTCM leftovers) ]

            unless (null otherPats) __IMPOSSIBLE__

            -- Get the user-written names for the pattern variables
            let (vars, asb1) = getUserVariableNames delta patVars
                asb          = [AsBinding]
    asb0 [AsBinding] -> [AsBinding] -> [AsBinding]
    forall a. [a] -> [a] -> [a]
    ++ [AsBinding]
    asb1

            -- Rename internal patterns with these names
            let 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         = [DeBruijnPattern] -> PatternSubstitution
    forall a. DeBruijn a => [a] -> Substitution' a
    parallelS ([DeBruijnPattern] -> PatternSubstitution)
    -> [DeBruijnPattern] -> PatternSubstitution
    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..]

            qs <- transferOrigins (cps ++ ps) $ applySubst ren qs0

            let 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 = Int
    -> Telescope
    -> [NamedArg DeBruijnPattern]
    -> Bool
    -> Arg Type
    -> Substitution
    -> [AsBinding]
    -> IntSet
    -> Bool
    -> LHSResult
    LHSResult (Context -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length Context
    cxt) Telescope
    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) Bool
    ixsplit

            -- Debug output
            reportSDoc "tc.lhs.top" 10 $
              vcat [ "checked lhs:"
                   , nest 2 $ vcat
                     [ "delta   = " <+> prettyTCM delta
                     , "dots    = " <+> addContext delta (brackets $ fsep $ punctuate comma $ map prettyTCM dots)
                     , "asb     = " <+> addContext delta (brackets $ fsep $ punctuate comma $ map prettyTCM asb)
                     , "absurds = " <+> addContext delta (brackets $ fsep $ punctuate comma $ map prettyTCM absurds)
                     , "qs      = " <+> addContext delta (prettyList $ map pretty qs)
                     , "b       = " <+> addContext delta (prettyTCM b)
                     ]
                   ]
            reportSDoc "tc.lhs.top" 30 $
              nest 2 $ vcat
                     [ "vars   = " <+> pretty vars
                     , "b      = " <+> pretty b
                     ]
            reportSDoc "tc.lhs.top" 20 $ nest 2 $ "withSub  = " <+> pretty withSub
            reportSDoc "tc.lhs.top" 20 $ nest 2 $ "weakSub  = " <+> pretty weakSub
            reportSDoc "tc.lhs.top" 20 $ nest 2 $ "patSub   = " <+> pretty patSub
            reportSDoc "tc.lhs.top" 20 $ nest 2 $ "paramSub = " <+> pretty paramSub

            newCxt <- computeLHSContext vars delta

            updateContext paramSub (const newCxt) $ do

              reportSDoc "tc.lhs.top" 10 $ "bound pattern variables"
              reportSDoc "tc.lhs.top" 60 $ nest 2 $ "context = " <+> (pretty =<< getContextTelescope)
              reportSDoc "tc.lhs.top" 10 $ nest 2 $ "type  = " <+> prettyTCM b
              reportSDoc "tc.lhs.top" 60 $ nest 2 $ "type  = " <+> pretty b

              bindAsPatterns asb $ do

                -- Check dot patterns
                mapM_ checkDotPattern dots
                mapM_ checkAbsurdPattern absurds
                mapM_ checkAnnotationPattern annps

              -- Issue2303: don't bind asb' for the continuation (return in lhsResult instead)
              ret lhsResult

      st0 <- initLHSState tel eqs0 ps a finalChecks

      -- after we have introduced variables, we can add the patterns stripped by
      -- with-desugaring to the state.
      let withSub = Substitution -> Maybe Substitution -> Substitution
    forall a. a -> Maybe a -> a
    fromMaybe Substitution
    forall a. HasCallStack => a
    __IMPOSSIBLE__ Maybe Substitution
    withSub'
      withEqs <- updateProblemEqs $ applySubst withSub strippedPats
      -- Jesper, 2017-05-13: re-check the stripped patterns here!
      inTopContext $ addContext (st0 ^. lhsTel) $
        forM_ withEqs recheckStrippedWithPattern

      let st = Lens' (LHSState a) [ProblemEq] -> LensMap (LHSState a) [ProblemEq]
    forall o i. Lens' o i -> LensMap o i
    over ((Problem a -> f (Problem a)) -> LHSState a -> f (LHSState a)
    forall a (f :: * -> *).
    Functor f =>
    (Problem a -> f (Problem a)) -> LHSState a -> f (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 (f :: * -> *).
    Functor f =>
    ([ProblemEq] -> f [ProblemEq]) -> Problem a -> f (Problem a)
    problemEqs) ([ProblemEq] -> [ProblemEq] -> [ProblemEq]
    forall a. [a] -> [a] -> [a]
    ++ [ProblemEq]
    withEqs) LHSState a
    st0

      -- doing the splits:
      let initLHSContext = LHSContext { lhsRange :: Range
    lhsRange = Range
    lhsRng, lhsContextSize :: Int
    lhsContextSize = Context -> Int
    forall a. Sized a => a -> Int
    size Context
    cxt }
      (result, block) <- unsafeInTopContext $ runWriterT $ (`runReaderT` initLHSContext) $ checkLHS f st
      return result

    -- | Check that this split will generate a modality-correct internal
    -- clause when --cubical-compatible is used. This means that the type of
    -- anything which might be transported must be modality-correct. This is
    -- necessarily an approximate check. We assume that any argument which
    -- (a) comes after and (b) mentions a dotted argument will be
    -- transported, which is probably an overestimate.
    conSplitModalityCheck ::
         Range
           -- ^ Range of the whole left hand side, for error reporting.
      -> Modality
           -- ^ Modality to check at.
      -> PatternSubstitution
          -- ^ Substitution resulting from index unification. @Γ ⊢ ρ : Δ'@,
          -- where @Δ'@ is the context we're in, and @Γ@ is the clause telescope
          -- before unification.
      -> Int       -- ^ Variable @x@ at which we split.
      -> Telescope -- ^ The telescope @Γ@ itself.
      -> Type      -- ^ Target type of the clause.
      -> TCM ()
    conSplitModalityCheck :: Range
    -> Modality
    -> PatternSubstitution
    -> Int
    -> Telescope
    -> Type
    -> TCMT IO ()
    conSplitModalityCheck Range
    lhsRng Modality
    mod PatternSubstitution
    rho Int
    blocking Telescope
    gamma Type
    target = Bool -> TCMT IO () -> TCMT IO ()
    forall b (m :: * -> *). (IsBool b, Monad m) => b -> m () -> m ()
    when ((Dom Type -> Bool) -> Telescope -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any ((Modality -> Modality -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Modality
    defaultModality) (Modality -> Bool) -> (Dom Type -> Modality) -> Dom Type -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Dom Type -> Modality
    forall a. LensModality a => a -> Modality
    getModality) Telescope
    gamma) (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.top" 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
    "LHS modality check for modality: " TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> Modality -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    forall (m :: * -> *). MonadPretty m => Modality -> m Doc
    prettyTCM Modality
    mod
        , TCMT IO Doc
    "rho:    " 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 (tcm :: * -> *) a.
    (MonadTCEnv tcm, ReadTCState tcm) =>
    tcm a -> tcm a
    inTopContext (PatternSubstitution -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    forall (m :: * -> *). MonadPretty m => PatternSubstitution -> m Doc
    prettyTCM PatternSubstitution
    rho)
        , TCMT IO Doc
    "gamma:  " 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 (tcm :: * -> *) a.
    (MonadTCEnv tcm, ReadTCState tcm) =>
    tcm a -> tcm a
    inTopContext (Telescope -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    forall (m :: * -> *). MonadPretty m => Telescope -> m Doc
    prettyTCM Telescope
    gamma)
        , TCMT IO Doc
    "target: " 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
    forall (m :: * -> *). MonadPretty m => Type -> m Doc
    prettyTCM Type
    target
        , TCMT IO Doc
    "target (raw): " TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> Type -> TCMT IO Doc
    forall (m :: * -> *) a. (Applicative m, Pretty a) => a -> m Doc
    pretty Type
    target
        , TCMT IO Doc
    "Δ'target: " 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
    forall (m :: * -> *). MonadPretty m => Type -> m Doc
    prettyTCM (PatternSubstitution -> Type -> Type
    forall a. TermSubst a => PatternSubstitution -> a -> a
    applyPatSubst PatternSubstitution
    rho Type
    target)
        , TCMT IO Doc
    "blocking:" 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
    forall (m :: * -> *). MonadPretty m => Int -> m Doc
    prettyTCM Int
    blocking
        ]
      Maybe Int -> (Int -> TCMT IO ()) -> TCMT IO ()
    forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
    whenJust (PatternSubstitution -> Int -> Maybe Int
    firstForced PatternSubstitution
    rho (Telescope -> Int
    forall a. Tele a -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length Telescope
    gamma)) \ Int
    ix -> do
          -- We've found a forced argument. This means that the unifier has
          -- decided to kill a unification variable, and any of its
          -- occurrences in the generated term will be replaced by an
          -- occurrence of a path, and any terms whose types mention that
          -- variable will be transported.
          let
            (Telescope
    gamma0, Telescope
    delta) = Int -> Telescope -> (Telescope, Telescope)
    splitTelescopeAt (Telescope -> Int
    forall a. Tele a -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length Telescope
    gamma Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    ix) Telescope
    gamma
            name :: Int -> TCMT IO Name
    name = TCMT IO Name -> TCMT IO Name
    forall (tcm :: * -> *) a.
    (MonadTCEnv tcm, ReadTCState tcm) =>
    tcm a -> tcm a
    inTopContext (TCMT IO Name -> TCMT IO Name)
    -> (Int -> TCMT IO Name) -> Int -> TCMT IO Name
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Telescope -> TCMT IO Name -> TCMT IO Name
    forall b (m :: * -> *) a.
    (AddContext b, MonadAddContext m) =>
    b -> m a -> m a
    forall (m :: * -> *) a.
    MonadAddContext m =>
    Telescope -> m a -> m a
    addContext Telescope
    gamma (TCMT IO Name -> TCMT IO Name)
    -> (Int -> TCMT IO Name) -> Int -> TCMT IO Name
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> TCMT IO Name
    forall (m :: * -> *). (MonadDebug m, MonadTCEnv m) => Int -> m Name
    nameOfBV
            delta'target :: Type
    delta'target = PatternSubstitution -> Type -> Type
    forall a. TermSubst a => PatternSubstitution -> a -> a
    applyPatSubst PatternSubstitution
    rho Type
    target
          [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
    $ [TCMT IO Doc] -> TCMT IO Doc
    forall (m :: * -> *) (t :: * -> *).
    (Applicative m, Foldable t) =>
    t (m Doc) -> m Doc
    vcat
            [ TCMT IO Doc
    "found forced argument!"
            , TCMT IO Doc
    "forced: " 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
    forall (m :: * -> *). MonadPretty m => Int -> m Doc
    prettyTCM Int
    ix
            , TCMT IO Doc
    "before: " 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 (tcm :: * -> *) a.
    (MonadTCEnv tcm, ReadTCState tcm) =>
    tcm a -> tcm a
    inTopContext (Telescope -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    forall (m :: * -> *). MonadPretty m => Telescope -> m Doc
    prettyTCM Telescope
    gamma0)
            , TCMT IO Doc
    "after:  " 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 (tcm :: * -> *) a.
    (MonadTCEnv tcm, ReadTCState tcm) =>
    tcm a -> tcm a
    inTopContext (Telescope -> TCMT IO Doc -> TCMT IO Doc
    forall b (m :: * -> *) a.
    (AddContext b, MonadAddContext m) =>
    b -> m a -> m a
    forall (m :: * -> *) a.
    MonadAddContext m =>
    Telescope -> m a -> m a
    addContext Telescope
    gamma0 (Telescope -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    forall (m :: * -> *). MonadPretty m => Telescope -> m Doc
    prettyTCM Telescope
    delta))
            ]
          forced <- Int -> TCMT IO Name
    name Int
    ix
          forM_ (zip [ix - 1, ix - 2 ..] (telToList delta)) $ \(Int
    arg, Dom ([Char], Type)
    d) -> do
            -- Example: The first argument after the first forced variable. So
            -- we have e.g.:
            --   Γ = Γ₀.x.Δ
            --   Δ' ⊢ ρ : Γ₀.x.Δ
            --   Γ₀ ⊢ x : Type
            -- but we need
            --   Δ' ⊢ x : Type,
            -- since Δ' is the context we are in. Then we have
            --   Γ ⊢ x[wkS |Δ|] : Type
            -- and consequently
            --   Δ' ⊢ x[wkS |Δ|][ρ] : Type
            let
              rho' :: PatternSubstitution
    rho' = PatternSubstitution -> PatternSubstitution -> PatternSubstitution
    forall a.
    EndoSubst a =>
    Substitution' a -> Substitution' a -> Substitution' a
    composeS PatternSubstitution
    rho (Int -> PatternSubstitution -> PatternSubstitution
    forall a. Int -> Substitution' a -> Substitution' a
    wkS (Int
    arg Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1) PatternSubstitution
    forall a. Substitution' a
    idS)
            ty' <- Term -> TCMT IO Term
    forall a (m :: * -> *). (Reduce a, MonadReduce m) => a -> m a
    reduce (PatternSubstitution -> Term -> Term
    forall a. TermSubst a => PatternSubstitution -> a -> a
    applyPatSubst PatternSubstitution
    rho' (Type -> Term
    forall t a. Type'' t a -> a
    unEl (([Char], Type) -> Type
    forall a b. (a, b) -> b
    snd (Dom ([Char], Type) -> ([Char], Type)
    forall t e. Dom' t e -> e
    unDom Dom ([Char], Type)
    d))))
            let
              -- It's actually rather tricky to know when, exactly, a
              -- transport will be needed in a position that forces an
              -- usable-at-modality check. Our current heuristic is:
              --
              -- The variable we're looking at has a fibrant type, with the
              -- first forced variable free.
              -- The variable appears free in the result type.
              docheck = [Bool] -> Bool
    forall (t :: * -> *). Foldable t => t Bool -> Bool
    and
                [ Int
    ix Int -> Term -> Bool
    forall a. Free a => Int -> a -> Bool
    `freeIn` Substitution' (SubstArg Term) -> Term -> Term
    forall a. Subst a => Substitution' (SubstArg a) -> a -> a
    applySubst (Int -> Substitution -> Substitution
    forall a. Int -> Substitution' a -> Substitution' a
    wkS (Int
    arg Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1) Substitution
    forall a. Substitution' a
    idS) (Type -> Term
    forall t a. Type'' t a -> a
    unEl (([Char], Type) -> Type
    forall a b. (a, b) -> b
    snd (Dom ([Char], Type) -> ([Char], Type)
    forall t e. Dom' t e -> e
    unDom Dom ([Char], Type)
    d)))
                , Int
    arg Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Int
    blocking
                , Int
    arg Int -> Type -> Bool
    forall a. Free a => Int -> a -> Bool
    `freeIn` Type
    target
                ]
            reportSDoc "tc.lhs.top" 30 $ vcat
              [ "arg:        " <+> pretty arg
              , "arg type:   " <+> prettyTCM (applySubst (wkS (arg + 1) idS) (unEl (snd (unDom d))))
              , "check       " <+> pretty docheck
              ]
            argn <- name arg
            when docheck $
              usableAtModality (IndexedClauseArg forced argn) mod ty'

      -- ALways check the target clause type. Specifically, we check it both
      -- in Δ' and in Γ. The check in Δ' will sometimes let slip by a
      -- quantity violation which is masked by an indexed match (recall that
      -- the unifier likes to replace @0-variables for @ω-variables). A
      -- concrete case where this happens is #5468. Check in Δ' first since
      -- that will have the forced variable names.
      Range -> TCMT IO () -> TCMT IO ()
    forall (m :: * -> *) x a.
    (MonadTrace m, HasRange x) =>
    x -> m a -> m a
    setCurrentRange Range
    lhsRng do
        WhyCheckModality -> Modality -> Term -> TCMT IO ()
    MonadConstraint (TCMT IO) =>
    WhyCheckModality -> Modality -> Term -> TCMT IO ()
    usableAtModality WhyCheckModality
    IndexedClause Modality
    mod (Type -> Term
    forall t a. Type'' t a -> a
    unEl (PatternSubstitution -> Type -> Type
    forall a. TermSubst a => PatternSubstitution -> a -> a
    applyPatSubst PatternSubstitution
    rho Type
    target))
        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
    $ Telescope -> TCMT IO () -> TCMT IO ()
    forall b (m :: * -> *) a.
    (AddContext b, MonadAddContext m) =>
    b -> m a -> m a
    forall (m :: * -> *) a.
    MonadAddContext m =>
    Telescope -> m a -> m a
    addContext Telescope
    gamma (TCMT IO () -> TCMT IO ()) -> TCMT IO () -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ WhyCheckModality -> Modality -> Term -> TCMT IO ()
    MonadConstraint (TCMT IO) =>
    WhyCheckModality -> Modality -> Term -> TCMT IO ()
    usableAtModality WhyCheckModality
    IndexedClause Modality
    mod (Type -> Term
    forall t a. Type'' t a -> a
    unEl Type
    target)
      where
        -- Find the first dotted pattern in the substitution. "First" =
        -- "earliest bound", so counts down from the length of the
        -- telescope.
        firstForced :: PatternSubstitution -> Int -> Maybe Int
        firstForced :: PatternSubstitution -> Int -> Maybe Int
    firstForced PatternSubstitution
    pat Int
    level
          | Int
    level Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    0 = case PatternSubstitution -> Int -> DeBruijnPattern
    forall a. EndoSubst a => Substitution' a -> Int -> a
    lookupS PatternSubstitution
    pat Int
    level of
            DotP{} -> Int -> Maybe Int
    forall a. a -> Maybe a
    Just Int
    level
            DeBruijnPattern
    _ -> PatternSubstitution -> Int -> Maybe Int
    firstForced PatternSubstitution
    pat (Int
    level Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1)
          | Bool
    otherwise = Maybe Int
    forall a. Maybe a
    Nothing

    -- | 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 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 = 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 LHSContext 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 LHSContext 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 Telescope
    tel [NamedArg DeBruijnPattern]
    ip Problem a
    problem Arg Type
    target [Maybe Int]
    psplit Bool
    _) = 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' (LHSState a) [Dom ([Char], Type)]
    -> LensMap (LHSState a) [Dom ([Char], Type)]
    forall o i. Lens' o i -> LensMap o i
    over ((Telescope -> f Telescope) -> LHSState a -> f (LHSState a)
    forall a (f :: * -> *).
    Functor f =>
    (Telescope -> f Telescope) -> LHSState a -> f (LHSState a)
    lhsTel ((Telescope -> f Telescope) -> LHSState a -> f (LHSState a))
    -> (([Dom ([Char], Type)] -> f [Dom ([Char], Type)])
        -> Telescope -> f Telescope)
    -> ([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)])
    -> Telescope -> f Telescope
    Lens' Telescope [Dom ([Char], 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 Telescope
    tel [NamedArg DeBruijnPattern]
    ip Problem a
    problem Arg Type
    target [Maybe Int]
    psplit Bool
    ixsplit) = do
      [Char] -> Int -> TCMT IO Doc -> tcm ()
    forall (m :: * -> *).
    MonadDebug m =>
    [Char] -> Int -> TCMT IO Doc -> m ()
    reportSDoc [Char]
    "tc.lhs" Int
    40 (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
    <+> Telescope -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    forall (m :: * -> *). MonadPretty m => Telescope -> m Doc
    prettyTCM Telescope
    tel
      [Char] -> Int -> TCMT IO Doc -> tcm ()
    forall (m :: * -> *).
    MonadDebug m =>
    [Char] -> Int -> TCMT IO Doc -> m ()
    reportSDoc [Char]
    "tc.lhs" Int
    40 (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
      [Char] -> Int -> TCMT IO Doc -> tcm ()
    forall (m :: * -> *).
    MonadDebug m =>
    [Char] -> Int -> TCMT IO Doc -> m ()
    reportSDoc [Char]
    "tc.lhs" Int
    40 (TCMT IO Doc -> tcm ()) -> TCMT IO Doc -> tcm ()
    forall a b. (a -> b) -> a -> b
    $ TCMT IO Doc
    "target is" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> Telescope -> TCMT IO Doc -> TCMT IO Doc
    forall b (m :: * -> *) a.
    (AddContext b, MonadAddContext m) =>
    b -> m a -> m a
    forall (m :: * -> *) a.
    MonadAddContext m =>
    Telescope -> m a -> m a
    addContext Telescope
    tel (Arg Type -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    forall (m :: * -> *). MonadPretty m => Arg Type -> m Doc
    prettyTCM Arg Type
    target)
      if Problem a -> Bool
    forall a. Problem a -> Bool
    isSolvedProblem Problem a
    problem then
        TCM a -> tcm a
    forall a. 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' (Problem a) (LHSState a -> TCM a) -> LHSState a -> TCM a
    forall o i. o -> Lens' o i -> i
    ^. ((LHSState a -> TCM a) -> f (LHSState a -> TCM a))
    -> Problem a -> f (Problem a)
    forall a (f :: * -> *).
    Functor f =>
    ((LHSState a -> TCM a) -> f (LHSState a -> TCM a))
    -> Problem a -> f (Problem a)
    Lens' (Problem a) (LHSState a -> TCM 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
    forall (m :: * -> *). MonadPretty m => LHSState 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 b (m :: * -> *). (IsBool b, Monad m) => b -> m () -> m ()
    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
    NeedOptionPatternMatching

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

        (ProblemEq
     -> tcm (Either [TCErr] (LHSState a))
     -> tcm (Either [TCErr] (LHSState a)))
    -> tcm (Either [TCErr] (LHSState a))
    -> [ProblemEq]
    -> tcm (Either [TCErr] (LHSState a))
    forall a b. (a -> b -> b) -> b -> [a] -> b
    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 a b. tcm a -> (a -> tcm b) -> tcm b
    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 LHSContext 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 a. 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 a b. tcm a -> (a -> tcm b) -> tcm b
    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 a. a -> tcm 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 b c d. (b -> c) -> Either b d -> Either c d
    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' (Problem a) [NamedArg Pattern] -> [NamedArg Pattern]
    forall o i. o -> Lens' o i -> i
    ^. ([NamedArg Pattern] -> f [NamedArg Pattern])
    -> Problem a -> f (Problem a)
    forall a (f :: * -> *).
    Functor f =>
    ([NamedArg Pattern] -> f [NamedArg Pattern])
    -> Problem a -> f (Problem a)
    Lens' (Problem a) [NamedArg Pattern]
    problemRestPats of
          []    -> Either [TCErr] (LHSState a) -> tcm (Either [TCErr] (LHSState a))
    forall a. a -> tcm 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 b c d. (b -> c) -> Either b d -> Either c d
    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 a. Call -> ExceptT TCErr tcm a -> ExceptT TCErr tcm a
    forall (m :: * -> *) a. MonadTrace m => Call -> m a -> m a
    traceCall (Pattern -> Telescope -> Type -> Call
    CheckPattern Pattern
    p Telescope
    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.
          i <- TCM Int -> ExceptT TCErr tcm Int
    forall a. TCM a -> ExceptT TCErr tcm a
    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
    $ Telescope -> TCM Int -> TCM Int
    forall b (m :: * -> *) a.
    (AddContext b, MonadAddContext m) =>
    b -> m a -> m a
    forall (m :: * -> *) a.
    MonadAddContext m =>
    Telescope -> m a -> m a
    addContext Telescope
    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 a. a -> TCMT IO a
    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 = Telescope -> Int
    forall a. Sized a => a -> Int
    size Telescope
    tel Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - (Int
    i Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1)
              (delta1, tel'@(ExtendTel dom adelta2)) = splitTelescopeAt pos tel -- TODO:: tel' defined but not used

          p <- expandLitPattern p
          let splitOnPat = \case
                (A.LitP PatInfo
    _ Literal
    l)      -> Telescope
    -> Dom Type
    -> Abs Telescope
    -> Literal
    -> ExceptT TCErr tcm (LHSState a)
    splitLit Telescope
    delta1 Dom Type
    dom Abs Telescope
    adelta2 Literal
    l
                p :: Pattern
    p@A.RecP{}        -> Telescope
    -> Dom Type
    -> Abs Telescope
    -> Pattern
    -> Maybe AmbiguousQName
    -> ExceptT TCErr tcm (LHSState a)
    splitCon Telescope
    delta1 Dom Type
    dom Abs Telescope
    adelta2 Pattern
    p Maybe AmbiguousQName
    forall a. Maybe a
    Nothing
                p :: Pattern
    p@(A.ConP ConPatInfo
    _ AmbiguousQName
    c [NamedArg Pattern]
    ps) -> Telescope
    -> Dom Type
    -> Abs Telescope
    -> Pattern
    -> Maybe AmbiguousQName
    -> ExceptT TCErr tcm (LHSState a)
    splitCon Telescope
    delta1 Dom Type
    dom Abs Telescope
    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
    _ List1 (Expr, Expr)
    ts) -> Telescope
    -> Dom Type
    -> Abs Telescope
    -> List1 (Expr, Expr)
    -> ExceptT TCErr tcm (LHSState a)
    splitPartial Telescope
    delta1 Dom Type
    dom Abs Telescope
    adelta2 List1 (Expr, Expr)
    ts
                A.AsP PatInfo
    _ BindName
    _ 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__
          splitOnPat 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
    forall (m :: * -> *). MonadPretty m => Arg Type -> 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@
          (orig, 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 a. a -> ExceptT TCErr tcm a
    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
    $ Telescope
    -> ExceptT TCErr tcm (ProjOrigin, AmbiguousQName)
    -> ExceptT TCErr tcm (ProjOrigin, AmbiguousQName)
    forall b (m :: * -> *) a.
    (AddContext b, MonadAddContext m) =>
    b -> m a -> m a
    forall (m :: * -> *) a.
    MonadAddContext m =>
    Telescope -> m a -> m a
    addContext Telescope
    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
            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
            softTypeError $ CannotEliminateWithPattern block p (unArg target)

          (projName, comatchingAllowed, recName, projType, ai) <- suspendErrors $ 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 = 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
            addContext tel $ disambiguateProjection h ambProjName target

          unless comatchingAllowed $ do
            hardTypeError $ ComatchingDisabledForRecord recName

          -- Compute the new rest type by applying the projection type to 'self'.
          -- Note: we cannot be in a let binding.
          let f = QName -> Maybe QName -> QName
    forall a. a -> Maybe a -> a
    fromMaybe QName
    forall a. HasCallStack => a
    __IMPOSSIBLE__ Maybe QName
    mf
          let 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
          target' <- traverse (`piApplyM` self) projType

          -- Compute the new state
          let projP    = Bool
    -> (NamedArg DeBruijnPattern -> NamedArg DeBruijnPattern)
    -> NamedArg DeBruijnPattern
    -> NamedArg DeBruijnPattern
    forall b a. IsBool b => b -> (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]
    -> [NamedArg DeBruijnPattern] -> [NamedArg DeBruijnPattern]
    forall a. [a] -> [a] -> [a]
    ++ [NamedArg DeBruijnPattern
    projP]
              -- drop the projection pattern (already splitted)
              problem' = Lens' (Problem a) [NamedArg Pattern]
    -> LensMap (Problem a) [NamedArg Pattern]
    forall o i. Lens' o i -> LensMap o i
    over ([NamedArg Pattern] -> f [NamedArg Pattern])
    -> Problem a -> f (Problem a)
    forall a (f :: * -> *).
    Functor f =>
    ([NamedArg Pattern] -> f [NamedArg Pattern])
    -> Problem a -> f (Problem a)
    Lens' (Problem a) [NamedArg Pattern]
    problemRestPats (Int -> [NamedArg Pattern] -> [NamedArg Pattern]
    forall a. Int -> [a] -> [a]
    drop Int
    1) Problem a
    problem
          liftTCM $ updateLHSState (LHSState tel ip' problem' target' psplit ixsplit)

        -- 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.
          -> List1 (A.Expr, A.Expr)
                -- [(φ₁ = b1),..,(φn = bn)]
          -> ExceptT TCErr tcm (LHSState a)

        splitPartial :: Telescope
    -> Dom Type
    -> Abs Telescope
    -> List1 (Expr, Expr)
    -> ExceptT TCErr tcm (LHSState a)
    splitPartial Telescope
    delta1 Dom Type
    dom Abs Telescope
    adelta2 List1 (Expr, Expr)
    ts = do

          Bool -> ExceptT TCErr tcm () -> ExceptT TCErr tcm ()
    forall b (m :: * -> *). (IsBool b, Monad m) => b -> m () -> m ()
    unless (Dom Type -> Bool
    forall t e. Dom' t e -> Bool
    domIsFinite Dom 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 a. TCM a -> ExceptT TCErr tcm a
    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
    $ Telescope -> TCMT IO () -> TCMT IO ()
    forall b (m :: * -> *) a.
    (AddContext b, MonadAddContext m) =>
    b -> m a -> m a
    forall (m :: * -> *) a.
    MonadAddContext m =>
    Telescope -> m a -> m a
    addContext Telescope
    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 ()) -> TypeError -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ Dom Type -> TypeError
    SplitOnPartial Dom Type
    dom

          tInterval <- TCMT IO Type -> ExceptT TCErr tcm Type
    forall a. TCM a -> ExceptT TCErr tcm a
    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

          names <- liftTCM $ addContext tel $ do
            LeftoverPatterns{patternVariables = vars} <- getLeftoverPatterns $ problem ^. problemEqs
            return $ take (size delta1) $ fst $ getUserVariableNames tel 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 |Ξ|
          --
          lhsCxtSize <- asks lhsContextSize -- size of the context before checkLHS call.
          reportSDoc "tc.lhs.split.partial" 10 $ "lhsCxtSize =" <+> prettyTCM lhsCxtSize

          newContext <- liftTCM $ computeLHSContext names delta1
          reportSDoc "tc.lhs.split.partial" 10 $ "newContext =" <+> prettyTCM newContext

          let 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

          (gamma,sigma) <- liftTCM $ updateContext cpSub (const newContext) $ do
             ts <- forM ts $ \ (Expr
    lhs, Expr
    rhs) -> 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
    forall (m :: * -> *). MonadPretty m => Context -> 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
    forall (m :: * -> *). MonadPretty m => (Expr, Expr) -> m Doc
    prettyTCM (Expr
    lhs, Expr
    rhs)
                     t <- Expr -> Type -> TCMT IO Term
    checkExpr Expr
    lhs Type
    tInterval
                     u <- checkExpr rhs tInterval
                     reportSDoc "tc.lhs.split.partial" 10 $ text "t, u        =" <+> pretty (t, u)
                     reduce u >>= intervalView >>= \case
                       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 a. a -> TCMT IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Term
    t
                       IntervalView
    IOne  -> Term -> TCMT IO Term
    forall a. a -> TCMT IO a
    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
    $ Expr -> TypeError
    ExpectedIntervalLiteral Expr
    rhs
             -- Example: ts = (i=0) (j=1) will result in phi = ¬ i & j
             phi <- 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) primIOne (fmap pure ts)
             reportSDoc "tc.lhs.split.partial" 10 $ text "phi           =" <+> prettyTCM phi
             reportSDoc "tc.lhs.split.partial" 30 $ text "phi           =" <+> pretty phi
             phi <- reduce phi
             reportSDoc "tc.lhs.split.partial" 10 $ text "phi (reduced) =" <+> prettyTCM phi
             refined <- forallFaceMaps phi (\ IntMap Bool
    bs Blocker
    m Term
    t -> Blocker -> TCM (Telescope, Substitution)
    forall a. Blocker -> TCMT IO a
    forall (m :: * -> *) a. MonadBlock m => Blocker -> m a
    patternViolation Blocker
    m)
                                (\IntMap Bool
    _ Substitution
    sigma -> (,Substitution
    sigma) (Telescope -> (Telescope, Substitution))
    -> TCMT IO Telescope -> TCM (Telescope, Substitution)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> TCMT IO Telescope
    forall (m :: * -> *). MonadTCEnv m => m Telescope
    getContextTelescope)
             case refined of
               [(Telescope
    gamma,Substitution
    sigma)] -> (Telescope, Substitution) -> TCM (Telescope, Substitution)
    forall a. a -> TCMT IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Telescope
    gamma,Substitution
    sigma)
               []              -> TypeError -> TCM (Telescope, Substitution)
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCError m) =>
    TypeError -> m a
    typeError TypeError
    FaceConstraintUnsatisfiable
               [(Telescope, Substitution)]
    _               -> TypeError -> TCM (Telescope, Substitution)
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCError m) =>
    TypeError -> m a
    typeError TypeError
    FaceConstraintDisjunction
          itisone <- liftTCM primItIsOne
          -- substitute the literal in p1 and dpi
          reportSDoc "tc.lhs.faces" 60 $ text $ show sigma

          let oix = Abs Telescope -> Int
    forall a. Sized a => a -> Int
    size Abs Telescope
    adelta2 -- de brujin index of IsOne
              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' = Abs Telescope -> SubstArg Telescope -> Telescope
    forall a. Subst a => Abs a -> SubstArg a -> a
    absApp Abs Telescope
    adelta2 Term
    SubstArg Telescope
    itisone
              delta2 = Substitution' (SubstArg Telescope) -> Telescope -> Telescope
    forall a. Subst a => Substitution' (SubstArg a) -> a -> a
    applySubst Substitution
    Substitution' (SubstArg Telescope)
    sigma Telescope
    delta2'
              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 = Just (Arg defaultArgInfo tInterval)
                                                  , conPFallThrough = 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 = (Term -> DeBruijnPattern) -> Substitution -> PatternSubstitution
    forall a b. (a -> b) -> Substitution' a -> Substitution' b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Term -> DeBruijnPattern
    mkConP Substitution
    sigma

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

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

          -- Compute the new state
          let problem' = Lens' (Problem a) [ProblemEq] -> LensSet (Problem a) [ProblemEq]
    forall o i. Lens' o i -> LensSet o i
    set ([ProblemEq] -> f [ProblemEq]) -> Problem a -> f (Problem a)
    forall a (f :: * -> *).
    Functor f =>
    ([ProblemEq] -> f [ProblemEq]) -> Problem a -> f (Problem a)
    Lens' (Problem a) [ProblemEq]
    problemEqs [ProblemEq]
    eqs' Problem a
    problem
          reportSDoc "tc.lhs.split.partial" 60 $ text (show problem')
          liftTCM $ updateLHSState (LHSState delta' ip' problem' target' (psplit ++ [Just o_n]) ixsplit)

        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 :: Telescope
    -> Dom Type
    -> Abs Telescope
    -> Literal
    -> ExceptT TCErr tcm (LHSState a)
    splitLit Telescope
    delta1 dom :: Dom 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 Telescope
    adelta2 Literal
    lit = do
          let delta2 :: Telescope
    delta2 = Abs Telescope -> SubstArg Telescope -> Telescope
    forall a. Subst a => Abs a -> SubstArg a -> a
    absApp Abs Telescope
    adelta2 (Literal -> Term
    Lit Literal
    lit)
              delta' :: Telescope
    delta' = Telescope -> Telescope -> Telescope
    forall t. Abstract t => Telescope -> t -> t
    abstract Telescope
    delta1 Telescope
    delta2
              rho :: PatternSubstitution
    rho    = Int -> DeBruijnPattern -> PatternSubstitution
    forall a. DeBruijn a => Int -> a -> Substitution' a
    singletonS (Telescope -> Int
    forall a. Sized a => a -> Int
    size Telescope
    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'     = PatternSubstitution -> [ProblemEq] -> [ProblemEq]
    forall a. TermSubst a => PatternSubstitution -> a -> a
    applyPatSubst PatternSubstitution
    rho ([ProblemEq] -> [ProblemEq]) -> [ProblemEq] -> [ProblemEq]
    forall a b. (a -> b) -> a -> b
    $ Problem a
    problem Problem a -> Lens' (Problem a) [ProblemEq] -> [ProblemEq]
    forall o i. o -> Lens' o i -> i
    ^. ([ProblemEq] -> f [ProblemEq]) -> Problem a -> f (Problem a)
    forall a (f :: * -> *).
    Functor f =>
    ([ProblemEq] -> f [ProblemEq]) -> Problem a -> f (Problem a)
    Lens' (Problem a) [ProblemEq]
    problemEqs
              ip' :: [NamedArg DeBruijnPattern]
    ip'      = Substitution' (SubstArg [NamedArg DeBruijnPattern])
    -> [NamedArg DeBruijnPattern] -> [NamedArg DeBruijnPattern]
    forall a. Subst a => Substitution' (SubstArg a) -> a -> a
    applySubst PatternSubstitution
    Substitution' (SubstArg [NamedArg DeBruijnPattern])
    rho [NamedArg DeBruijnPattern]
    ip
              target' :: Arg Type
    target'  = PatternSubstitution -> Arg Type -> Arg Type
    forall a. TermSubst a => PatternSubstitution -> a -> a
    applyPatSubst PatternSubstitution
    rho Arg Type
    target

          -- Andreas, 2010-09-07 cannot split on irrelevant args
          Bool -> ExceptT TCErr tcm () -> ExceptT TCErr tcm ()
    forall b (m :: * -> *). (IsBool b, Monad m) => b -> m () -> m ()
    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
    $
            Telescope -> ExceptT TCErr tcm () -> ExceptT TCErr tcm ()
    forall b (m :: * -> *) a.
    (AddContext b, MonadAddContext m) =>
    b -> m a -> m a
    forall (m :: * -> *) a.
    MonadAddContext m =>
    Telescope -> m a -> m a
    addContext Telescope
    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 Type -> TypeError
    SplitOnIrrelevant Dom 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
    $
            Telescope -> ExceptT TCErr tcm () -> ExceptT TCErr tcm ()
    forall b (m :: * -> *) a.
    (AddContext b, MonadAddContext m) =>
    b -> m a -> m a
    forall (m :: * -> *) a.
    MonadAddContext m =>
    Telescope -> m a -> m a
    addContext Telescope
    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 Type -> TypeError
    SplitOnUnusableCohesion Dom Type
    dom

          Bool -> ExceptT TCErr tcm () -> ExceptT TCErr tcm ()
    forall b (m :: * -> *). (IsBool b, Monad m) => b -> m () -> m ()
    unless (PolarityModality -> Bool
    forall a. LensModalPolarity a => a -> Bool
    splittablePolarity (ArgInfo -> PolarityModality
    forall a. LensModalPolarity a => a -> PolarityModality
    getModalPolarity ArgInfo
    info)) (ExceptT TCErr tcm () -> ExceptT TCErr tcm ())
    -> ExceptT TCErr tcm () -> ExceptT TCErr tcm ()
    forall a b. (a -> b) -> a -> b
    $
            Telescope -> ExceptT TCErr tcm () -> ExceptT TCErr tcm ()
    forall b (m :: * -> *) a.
    (AddContext b, MonadAddContext m) =>
    b -> m a -> m a
    forall (m :: * -> *) a.
    MonadAddContext m =>
    Telescope -> m a -> m a
    addContext Telescope
    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 Type -> TypeError
    SplitOnUnusablePolarity Dom 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
    $ Telescope -> TCMT IO () -> TCMT IO ()
    forall b (m :: * -> *) a.
    (AddContext b, MonadAddContext m) =>
    b -> m a -> m a
    forall (m :: * -> *) a.
    MonadAddContext m =>
    Telescope -> m a -> m a
    addContext Telescope
    delta1 (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 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' (Problem a) [ProblemEq] -> LensSet (Problem a) [ProblemEq]
    forall o i. Lens' o i -> LensSet o i
    set ([ProblemEq] -> f [ProblemEq]) -> Problem a -> f (Problem a)
    forall a (f :: * -> *).
    Functor f =>
    ([ProblemEq] -> f [ProblemEq]) -> Problem a -> f (Problem a)
    Lens' (Problem a) [ProblemEq]
    problemEqs [ProblemEq]
    eqs' Problem a
    problem
          TCM (LHSState a) -> ExceptT TCErr tcm (LHSState a)
    forall a. TCM a -> ExceptT TCErr tcm 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 (Telescope
    -> [NamedArg DeBruijnPattern]
    -> Problem a
    -> Arg Type
    -> [Maybe Int]
    -> Bool
    -> LHSState a
    forall a.
    Telescope
    -> [NamedArg DeBruijnPattern]
    -> Problem a
    -> Arg Type
    -> [Maybe Int]
    -> Bool
    -> LHSState a
    LHSState Telescope
    delta' [NamedArg DeBruijnPattern]
    ip' Problem a
    problem' Arg Type
    target' [Maybe Int]
    psplit Bool
    ixsplit)

        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 :: Telescope
    -> Dom Type
    -> Abs Telescope
    -> Pattern
    -> Maybe AmbiguousQName
    -> ExceptT TCErr tcm (LHSState a)
    splitCon Telescope
    delta1 dom :: Dom 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 Telescope
    adelta2 Pattern
    focusPat Maybe AmbiguousQName
    ambC = do
          let delta2 :: Telescope
    delta2 = Abs Telescope -> Telescope
    forall a. Subst a => Abs a -> a
    absBody Abs Telescope
    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
    <+> Telescope -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    forall (m :: * -> *). MonadPretty m => Telescope -> m Doc
    prettyTCM Telescope
    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
    <+> Telescope -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    forall (m :: * -> *). MonadPretty m => Telescope -> m Doc
    prettyTCM Telescope
    delta1
              , TCMT IO Doc
    "a      = " TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> Telescope -> TCMT IO Doc -> TCMT IO Doc
    forall b (m :: * -> *) a.
    (AddContext b, MonadAddContext m) =>
    b -> m a -> m a
    forall (m :: * -> *) a.
    MonadAddContext m =>
    Telescope -> m a -> m a
    addContext Telescope
    delta1 (Type -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    forall (m :: * -> *). MonadPretty m => Type -> 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
    <+> Telescope -> TCMT IO Doc -> TCMT IO Doc
    forall b (m :: * -> *) a.
    (AddContext b, MonadAddContext m) =>
    b -> m a -> m a
    forall (m :: * -> *) a.
    MonadAddContext m =>
    Telescope -> m a -> m a
    addContext Telescope
    delta1
                                  (([Char], Dom Type) -> TCMT IO Doc -> TCMT IO Doc
    forall b (m :: * -> *) a.
    (AddContext b, MonadAddContext m) =>
    b -> m a -> m a
    forall (m :: * -> *) a.
    MonadAddContext m =>
    ([Char], Dom Type) -> m a -> m a
    addContext ([Char]
    "x" :: String, Dom Type
    dom) (Telescope -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    forall (m :: * -> *). MonadPretty m => Telescope -> m Doc
    prettyTCM Telescope
    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 b (m :: * -> *). (IsBool b, Monad m) => b -> m () -> m ()
    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
    $ Telescope -> ExceptT TCErr tcm () -> ExceptT TCErr tcm ()
    forall b (m :: * -> *) a.
    (AddContext b, MonadAddContext m) =>
    b -> m a -> m a
    forall (m :: * -> *) a.
    MonadAddContext m =>
    Telescope -> m a -> m a
    addContext Telescope
    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 Type -> TypeError
    SplitOnIrrelevant Dom 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
    $
            Telescope -> ExceptT TCErr tcm () -> ExceptT TCErr tcm ()
    forall b (m :: * -> *) a.
    (AddContext b, MonadAddContext m) =>
    b -> m a -> m a
    forall (m :: * -> *) a.
    MonadAddContext m =>
    Telescope -> m a -> m a
    addContext Telescope
    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 Type -> TypeError
    SplitOnUnusableCohesion Dom Type
    dom

          Bool -> ExceptT TCErr tcm () -> ExceptT TCErr tcm ()
    forall b (m :: * -> *). (IsBool b, Monad m) => b -> m () -> m ()
    unless (PolarityModality -> Bool
    forall a. LensModalPolarity a => a -> Bool
    splittablePolarity (ArgInfo -> PolarityModality
    forall a. LensModalPolarity a => a -> PolarityModality
    getModalPolarity ArgInfo
    info)) (ExceptT TCErr tcm () -> ExceptT TCErr tcm ())
    -> ExceptT TCErr tcm () -> ExceptT TCErr tcm ()
    forall a b. (a -> b) -> a -> b
    $
            Telescope -> ExceptT TCErr tcm () -> ExceptT TCErr tcm ()
    forall b (m :: * -> *) a.
    (AddContext b, MonadAddContext m) =>
    b -> m a -> m a
    forall (m :: * -> *) a.
    MonadAddContext m =>
    Telescope -> m a -> m a
    addContext Telescope
    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 Type -> TypeError
    SplitOnUnusablePolarity Dom Type
    dom

          -- Should we attempt to compute a left inverse for this clause? When
          -- --cubical-compatible --flat-split is given, we don't generate a
          -- left inverse (at all). This means that, when the coverage checker
          -- gets to the clause this was in, it won't generate a (malformed!)
          -- transpX clause for @♭ matching.
          -- TODO(Amy): properly support transpX when @♭ stuff is in the
          -- context.
          let genTrx :: Maybe NoLeftInv
    genTrx = Bool -> NoLeftInv -> Maybe NoLeftInv
    forall a. Bool -> a -> Maybe a
    boolToMaybe ((ArgInfo -> Cohesion
    forall a. LensCohesion a => a -> Cohesion
    getCohesion ArgInfo
    info Cohesion -> Cohesion -> Bool
    forall a. Eq a => a -> a -> Bool
    == Cohesion
    Flat)) NoLeftInv
    SplitOnFlat

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

          checkMatchingAllowed d dr  -- No splitting on coinductive constructors.

          -- Issue #7503: use principal sort for checking if split is ok
          let a' = Lens' Type (Sort' Term) -> LensSet Type (Sort' Term)
    forall o i. Lens' o i -> LensSet o i
    set (Sort' Term -> f (Sort' Term)) -> Type -> f Type
    forall a. LensSort a => Lens' a (Sort' Term)
    Lens' Type (Sort' Term)
    lensSort Sort' Term
    s Type
    a
          addContext delta1 $ checkSortOfSplitVar dr a' delta2 (Just target)

          -- Jesper, 2019-09-13: if the data type we split on is a strict
          -- set, we locally enable --with-K during unification.
          withKIfStrict <- reduce (getSort a) <&> \ Sort' Term
    dsort ->
            Bool
    -> (TCMT IO UnificationResult -> TCMT IO UnificationResult)
    -> TCMT IO UnificationResult
    -> TCMT IO UnificationResult
    forall b a. IsBool b => b -> (a -> a) -> a -> a
    applyWhen (Sort' Term -> Bool
    forall t. Sort' t -> Bool
    isStrictDataSort Sort' Term
    dsort) ((TCMT IO UnificationResult -> TCMT IO UnificationResult)
     -> TCMT IO UnificationResult -> TCMT IO UnificationResult)
    -> (TCMT IO UnificationResult -> TCMT IO UnificationResult)
    -> TCMT IO UnificationResult
    -> TCMT IO UnificationResult
    forall a b. (a -> b) -> a -> b
    $ Lens' TCEnv Bool
    -> (Bool -> Bool)
    -> TCMT IO UnificationResult
    -> TCMT IO UnificationResult
    forall (m :: * -> *) a b.
    MonadTCEnv m =>
    Lens' TCEnv a -> (a -> a) -> m b -> m b
    locallyTC (Bool -> f Bool) -> TCEnv -> f TCEnv
    Lens' TCEnv Bool
    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

          -- The constructor should construct an element of this datatype
          (c :: ConHead, b :: Type) <- liftTCM $ addContext delta1 $ case 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 focusPat of
            A.ConP ConPatInfo
    cpi AmbiguousQName
    _ [NamedArg Pattern]
    _ | ConPatInfo -> ConPatLazy
    A.conPatLazy ConPatInfo
    cpi ConPatLazy -> ConPatLazy -> Bool
    forall a. Eq a => a -> a -> Bool
    == ConPatLazy
    A.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 a. a -> ExceptT TCErr tcm a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

          -- The type of the constructor will end in an application of the datatype
          (TelV gamma (El _ ctarget), boundary) <- liftTCM $ telViewPathBoundary b
          let Def d' es' = ctarget
              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
          reportSDoc "tc.lhs.split.con" 50 $ text "  boundary = " <+> prettyTCM boundary

          unless (d == d') {-'-} __IMPOSSIBLE__

          -- Get names for the constructor arguments from the user patterns
          gamma <- liftTCM $ case focusPat of
            A.ConP ConPatInfo
    _ AmbiguousQName
    _ [NamedArg Pattern]
    ps -> do
              ps <- ExpandHidden
    -> [NamedArg Pattern] -> Telescope -> TCMT IO [NamedArg Pattern]
    forall (m :: * -> *).
    (PureTCM m, MonadError TCErr m, MonadFresh NameId m,
     MonadTrace m) =>
    ExpandHidden
    -> [NamedArg Pattern] -> Telescope -> m [NamedArg Pattern]
    insertImplicitPatterns ExpandHidden
    ExpandLast [NamedArg Pattern]
    ps Telescope
    gamma
              return $ useNamesFromPattern ps gamma
            A.RecP KwRange
    _ ConPatInfo
    _ [FieldAssignment' Pattern]
    fs -> do
              RecordDefn def <- Definition -> Defn
    theDef (Definition -> Defn) -> TCMT IO Definition -> TCMT IO Defn
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> QName -> TCMT IO Definition
    forall (m :: * -> *). HasConstInfo m => QName -> m Definition
    getConstInfo QName
    d
              let axs = (Dom Name -> Arg Name) -> [Dom Name] -> [Arg Name]
    forall a b. (a -> b) -> [a] -> [b]
    map Dom Name -> Arg Name
    forall t a. Dom' t a -> Arg a
    argFromDom ([Dom Name] -> [Arg Name]) -> [Dom Name] -> [Arg Name]
    forall a b. (a -> b) -> a -> b
    $ RecordData -> [Dom Name]
    recordFieldNames RecordData
    def
              ps <- insertMissingFieldsFail d (const $ A.WildP empty) fs axs
              ps <- insertImplicitPatterns ExpandLast ps gamma
              return $ useNamesFromPattern ps gamma
            Pattern
    _ -> TCMT IO Telescope
    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 -> Modality
    composeModality (ArgInfo -> Modality
    forall a. LensModality a => a -> Modality
    getModality ArgInfo
    info)
          gamma <- return $ mapModality updMod <$> gamma

          -- Get the type of the datatype.
          da <- (`piApply` pars) . defType <$> getConstInfo d
          reportSDoc "tc.lhs.split" 30 $ "  da = " <+> prettyTCM da

          reportSDoc "tc.lhs.top" 15 $ addContext delta1 $
            sep [ "preparing to unify"
                , nest 2 $ vcat
                  [ "c      =" <+> prettyTCM c <+> ":" <+> prettyTCM b
                  , "d      =" <+> prettyTCM (Def d (map Apply pars)) <+> ":" <+> prettyTCM da
                  , "isRec  =" <+> (text . show) isRec
                  , "gamma  =" <+> prettyTCM gamma
                  , "pars   =" <+> brackets (fsep $ punctuate comma $ map prettyTCM pars)
                  , "ixs    =" <+> brackets (fsep $ punctuate comma $ map prettyTCM ixs)
                  , "cixs   =" <+> addContext gamma (brackets (fsep $ punctuate comma $ map prettyTCM cixs))
                  ]
                ]
                     -- We ignore forcing for make-case
          cforced <- ifM (viewTC eMakeCase) (return []) $
                     {-else-} defForced <$> getConstInfo (conName c)

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

          -- All variables are flexible.
          let flex = [IsForced] -> Telescope -> FlexibleVars
    allFlexVars [IsForced]
    forced (Telescope -> FlexibleVars) -> Telescope -> FlexibleVars
    forall a b. (a -> b) -> a -> b
    $ Telescope
    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.
          da' <- addContext delta1Gamma $ do
                 let updCoh = Cohesion -> Cohesion -> Cohesion
    composeCohesion (ArgInfo -> Cohesion
    forall a. LensCohesion a => a -> Cohesion
    getCohesion ArgInfo
    info)
                 TelV tel dt <- telView da'
                 return $ abstract (mapCohesion updCoh <$> tel) a

          let 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
    -> Telescope
    -> Args
    -> Args
    -> [UnificationFailure]
    -> SplitError
    UnificationStuck Maybe Blocker
    b (ConHead -> QName
    conName ConHead
    c) (Telescope
    delta1 Telescope -> Telescope -> Telescope
    forall t. Abstract t => Telescope -> t -> t
    `abstract` Telescope
    gamma) Args
    cixs Args
    ixs' [UnificationFailure]
    errs

          liftTCM (withKIfStrict $ unifyIndices genTrx delta1Gamma flex da' cixs ixs') >>= \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 (Telescope
    delta1',PatternSubstitution
    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
    <+> Telescope -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    forall (m :: * -> *). MonadPretty m => Telescope -> m Doc
    prettyTCM Telescope
    delta1'
                , TCMT IO Doc
    "rho0    =" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> Telescope -> TCMT IO Doc -> TCMT IO Doc
    forall b (m :: * -> *) a.
    (AddContext b, MonadAddContext m) =>
    b -> m a -> m a
    forall (m :: * -> *) a.
    MonadAddContext m =>
    Telescope -> m a -> m a
    addContext Telescope
    delta1' (PatternSubstitution -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    forall (m :: * -> *). MonadPretty m => PatternSubstitution -> m Doc
    prettyTCM PatternSubstitution
    rho0)
                , TCMT IO Doc
    "es      =" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> Telescope -> TCMT IO Doc -> TCMT IO Doc
    forall b (m :: * -> *) a.
    (AddContext b, MonadAddContext m) =>
    b -> m a -> m a
    forall (m :: * -> *) a.
    MonadAddContext m =>
    Telescope -> m a -> m a
    addContext Telescope
    delta1' ([Arg (Named NamedName Term)] -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    forall (m :: * -> *).
    MonadPretty m =>
    [Arg (Named NamedName Term)] -> 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 a b. (a -> b) -> [a] -> [b]
    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 a b. (a -> b) -> Arg a -> Arg b
    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 a b. (a -> b) -> Named NamedName a -> Named NamedName b
    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 (PatternSubstitution
    rho1,PatternSubstitution
    rho2) = Int
    -> PatternSubstitution
    -> (PatternSubstitution, PatternSubstitution)
    forall a.
    Int -> Substitution' a -> (Substitution' a, Substitution' a)
    splitS (Telescope -> Int
    forall a. Sized a => a -> Int
    size Telescope
    gamma) PatternSubstitution
    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
    $ Telescope -> TCMT IO Doc -> TCMT IO Doc
    forall b (m :: * -> *) a.
    (AddContext b, MonadAddContext m) =>
    b -> m a -> m a
    forall (m :: * -> *) a.
    MonadAddContext m =>
    Telescope -> m a -> m a
    addContext Telescope
    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
    <+> PatternSubstitution -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    forall (m :: * -> *). MonadPretty m => PatternSubstitution -> m Doc
    prettyTCM PatternSubstitution
    rho1
                , TCMT IO Doc
    "rho2    =" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> PatternSubstitution -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    forall (m :: * -> *). MonadPretty m => PatternSubstitution -> m Doc
    prettyTCM PatternSubstitution
    rho2
                ]

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

              -- Also remember if we are a record pattern.
              let cpi :: ConPatternInfo
    cpi = 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 PatternSubstitution
    Substitution' (SubstArg [NamedArg DeBruijnPattern])
    rho0 ([NamedArg DeBruijnPattern] -> [NamedArg DeBruijnPattern])
    -> [NamedArg DeBruijnPattern] -> [NamedArg DeBruijnPattern]
    forall a b. (a -> b) -> a -> b
    $ (Telescope -> Boundary -> [NamedArg DeBruijnPattern]
    forall a.
    DeBruijn a =>
    Telescope -> Boundary -> [NamedArg (Pattern' a)]
    telePatterns Telescope
    gamma Boundary
    boundary)
                  rho3 :: PatternSubstitution
    rho3    = DeBruijnPattern -> PatternSubstitution -> PatternSubstitution
    forall a. DeBruijn a => a -> Substitution' a -> Substitution' a
    consS DeBruijnPattern
    crho PatternSubstitution
    rho1
                  delta2' :: Telescope
    delta2' = PatternSubstitution -> Telescope -> Telescope
    forall a. TermSubst a => PatternSubstitution -> a -> a
    applyPatSubst PatternSubstitution
    rho3 Telescope
    delta2
                  delta' :: Telescope
    delta'  = Telescope
    delta1' Telescope -> Telescope -> Telescope
    forall t. Abstract t => Telescope -> t -> t
    `abstract` Telescope
    delta2'
                  rho :: PatternSubstitution
    rho     = Int -> PatternSubstitution -> PatternSubstitution
    forall a. Int -> Substitution' a -> Substitution' a
    liftS (Telescope -> Int
    forall a. Sized a => a -> Int
    size Telescope
    delta2) PatternSubstitution
    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
    $ Telescope -> TCMT IO Doc -> TCMT IO Doc
    forall b (m :: * -> *) a.
    (AddContext b, MonadAddContext m) =>
    b -> m a -> m a
    forall (m :: * -> *) a.
    MonadAddContext m =>
    Telescope -> m a -> m a
    addContext Telescope
    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
    forall (m :: * -> *). MonadPretty m => DeBruijnPattern -> 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
    <+> PatternSubstitution -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    forall (m :: * -> *). MonadPretty m => PatternSubstitution -> m Doc
    prettyTCM PatternSubstitution
    rho3
                , TCMT IO Doc
    "delta2' =" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> Telescope -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    forall (m :: * -> *). MonadPretty m => Telescope -> m Doc
    prettyTCM Telescope
    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
    $ Telescope -> TCMT IO Doc -> TCMT IO Doc
    forall b (m :: * -> *) a.
    (AddContext b, MonadAddContext m) =>
    b -> m a -> m a
    forall (m :: * -> *) a.
    MonadAddContext m =>
    Telescope -> m a -> m a
    addContext Telescope
    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
    <+> PatternSubstitution -> TCMT IO Doc
    forall (m :: * -> *) a. (Applicative m, Pretty a) => a -> m Doc
    pretty PatternSubstitution
    rho3
                , TCMT IO Doc
    "delta2' =" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> Telescope -> TCMT IO Doc
    forall (m :: * -> *) a. (Applicative m, Pretty a) => a -> m Doc
    pretty Telescope
    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
    <+> Telescope -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    forall (m :: * -> *). MonadPretty m => Telescope -> m Doc
    prettyTCM Telescope
    delta'
                , TCMT IO Doc
    "rho     =" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> Telescope -> TCMT IO Doc -> TCMT IO Doc
    forall b (m :: * -> *) a.
    (AddContext b, MonadAddContext m) =>
    b -> m a -> m a
    forall (m :: * -> *) a.
    MonadAddContext m =>
    Telescope -> m a -> m a
    addContext Telescope
    delta' (PatternSubstitution -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    forall (m :: * -> *). MonadPretty m => PatternSubstitution -> m Doc
    prettyTCM PatternSubstitution
    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 PatternSubstitution
    Substitution' (SubstArg [NamedArg DeBruijnPattern])
    rho [NamedArg DeBruijnPattern]
    ip
                  target' :: Arg Type
    target'  = PatternSubstitution -> Arg Type -> Arg Type
    forall a. TermSubst a => PatternSubstitution -> a -> a
    applyPatSubst PatternSubstitution
    rho Arg Type
    target

              -- Update the problem equations
              let eqs' :: [ProblemEq]
    eqs' = PatternSubstitution -> [ProblemEq] -> [ProblemEq]
    forall a. TermSubst a => PatternSubstitution -> a -> a
    applyPatSubst PatternSubstitution
    rho ([ProblemEq] -> [ProblemEq]) -> [ProblemEq] -> [ProblemEq]
    forall a b. (a -> b) -> a -> b
    $ Problem a
    problem Problem a -> Lens' (Problem a) [ProblemEq] -> [ProblemEq]
    forall o i. o -> Lens' o i -> i
    ^. ([ProblemEq] -> f [ProblemEq]) -> Problem a -> f (Problem a)
    forall a (f :: * -> *).
    Functor f =>
    ([ProblemEq] -> f [ProblemEq]) -> Problem a -> f (Problem a)
    Lens' (Problem a) [ProblemEq]
    problemEqs
                  problem' :: Problem a
    problem' = Lens' (Problem a) [ProblemEq] -> LensSet (Problem a) [ProblemEq]
    forall o i. Lens' o i -> LensSet o i
    set ([ProblemEq] -> f [ProblemEq]) -> Problem a -> f (Problem a)
    forall a (f :: * -> *).
    Functor f =>
    ([ProblemEq] -> f [ProblemEq]) -> Problem a -> f (Problem a)
    Lens' (Problem a) [ProblemEq]
    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.
              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'' = (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

              unless (null ixs) $
                whenM (withoutKOption `or2M` cubicalCompatibleOption) $ do
                  mod <- currentModality
                  lhsRng <- asks lhsRange
                  liftTCM $ addContext delta' $
                    conSplitModalityCheck lhsRng mod rho (length delta2) tel (unArg target)

              -- if rest type reduces,
              -- extend the split problem by previously not considered patterns
              st' <- liftTCM $ updateLHSState $ LHSState delta' ip' problem' target'' psplit (ixsplit || not (null ixs))

              reportSDoc "tc.lhs.top" 12 $ sep
                [ "new problem from rest"
                , nest 2 $ vcat
                  [ "delta'  =" <+> prettyTCM (st' ^. lhsTel)
                  , "eqs'    =" <+> addContext (st' ^. lhsTel) (prettyTCM $ st' ^. (lhsProblem . problemEqs))
                  , "ip'     =" <+> addContext (st' ^. lhsTel) (pretty $ st' ^. lhsOutPat)
                  ]
                ]
              return 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 InductionAndEta { recordInduction :: InductionAndEta -> Maybe Induction
    recordInduction=Maybe Induction
    ind, recordEtaEquality :: InductionAndEta -> EtaEquality
    recordEtaEquality=EtaEquality
    eta }
        | Just Induction
    CoInductive <- Maybe Induction
    ind -> TypeError -> m ()
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCError m) =>
    TypeError -> m a
    typeError TypeError
    SplitOnCoinductive
        | 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 a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
      DataOrRecord
    IsData -> () -> m ()
    forall a. a -> m a
    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
      ok <- TCM (Either TCErr a) -> m (Either TCErr a)
    forall a. TCM a -> m 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 a. TCMT IO a -> (TCErr -> TCMT IO a) -> TCMT IO a
    forall e (m :: * -> *) a.
    MonadError e m =>
    m a -> (e -> m a) -> m a
    `catchError` (Either TCErr a -> TCM (Either TCErr a)
    forall a. a -> TCMT IO 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)
      either throwError return 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 a. 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 a. 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

    type DataOrRecord = DataOrRecord' InductionAndEta

    -- | Check if the type is a data or record type and return its name,
    --   definition, sort, 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, Sort, Args, Args)
           -- ^ The 'Args' are parameters and indices.

    isDataOrRecordType :: forall (m :: * -> *).
    (MonadTCM m, PureTCM m) =>
    Type
    -> ExceptT TCErr m (DataOrRecord, QName, Sort' Term, Args, Args)
    isDataOrRecordType Type
    a0 = Type
    -> (Blocker
        -> Type
        -> ExceptT TCErr m (DataOrRecord, QName, Sort' Term, Args, Args))
    -> (NotBlocked
        -> Type
        -> ExceptT TCErr m (DataOrRecord, QName, Sort' Term, Args, Args))
    -> ExceptT TCErr m (DataOrRecord, QName, Sort' Term, 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, Sort' Term, Args, Args)
    blocked ((NotBlocked
      -> Type
      -> ExceptT TCErr m (DataOrRecord, QName, Sort' Term, Args, Args))
     -> ExceptT TCErr m (DataOrRecord, QName, Sort' Term, Args, Args))
    -> (NotBlocked
        -> Type
        -> ExceptT TCErr m (DataOrRecord, QName, Sort' Term, Args, Args))
    -> ExceptT TCErr m (DataOrRecord, QName, Sort' Term, 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 Definition -> ExceptT TCErr m Definition
    forall a. TCM a -> ExceptT TCErr m a
    forall (tcm :: * -> *) a. MonadTCM tcm => TCM a -> tcm a
    liftTCM (QName -> TCMT IO Definition
    forall (m :: * -> *). HasConstInfo m => QName -> m Definition
    getConstInfo QName
    d) ExceptT TCErr m Definition
    -> (Definition
        -> ExceptT TCErr m (DataOrRecord, QName, Sort' Term, Args, Args))
    -> ExceptT TCErr m (DataOrRecord, QName, Sort' Term, Args, Args)
    forall a b.
    ExceptT TCErr m a -> (a -> ExceptT TCErr m b) -> ExceptT TCErr m b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \Definition
    def -> case Definition -> Defn
    theDef Definition
    def of

          Datatype{dataPars :: Defn -> Int
    dataPars = Int
    np, dataSort :: Defn -> Sort' Term
    dataSort = Sort' Term
    s} -> 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, Sort' Term, Args, Args)
    -> ExceptT TCErr m (DataOrRecord, QName, Sort' Term, Args, Args)
    forall a. a -> ExceptT TCErr m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (DataOrRecord
    forall p. DataOrRecord' p
    IsData, QName
    d, Sort' Term
    s, Args
    pars, Args
    ixs)

          Record{ Maybe Induction
    recInduction :: Maybe Induction
    recInduction :: Defn -> Maybe Induction
    recInduction, EtaEquality
    recEtaEquality' :: EtaEquality
    recEtaEquality' :: Defn -> 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
            s <- Type -> ExceptT TCErr m (Sort' Term)
    forall (m :: * -> *).
    (PureTCM m, MonadBlock m, MonadError TCErr m) =>
    Type -> m (Sort' Term)
    shouldBeSort (Type -> ExceptT TCErr m (Sort' Term))
    -> ExceptT TCErr m Type -> ExceptT TCErr m (Sort' Term)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< Definition -> Type
    defType Definition
    def Type -> Args -> ExceptT TCErr m Type
    forall a (m :: * -> *).
    (PiApplyM a, MonadReduce m, HasBuiltins m) =>
    Type -> a -> m Type
    forall (m :: * -> *).
    (MonadReduce m, HasBuiltins m) =>
    Type -> Args -> m Type
    `piApplyM` Args
    pars
            return (IsRecord InductionAndEta {recordInduction=recInduction, recordEtaEquality=recEtaEquality' }, d, s, pars, [])

          -- Issue #2253: the data type could be abstract.
          AbstractDefn{} -> TypeError
    -> ExceptT TCErr m (DataOrRecord, QName, Sort' Term, Args, Args)
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCM m) =>
    TypeError -> m a
    hardTypeError (TypeError
     -> ExceptT TCErr m (DataOrRecord, QName, Sort' Term, Args, Args))
    -> TypeError
    -> ExceptT TCErr m (DataOrRecord, QName, Sort' Term, Args, Args)
    forall a b. (a -> b) -> a -> b
    $ QName -> TypeError
    SplitOnAbstract QName
    d

          -- the type could be an axiom
          Axiom{} -> TypeError
    -> ExceptT TCErr m (DataOrRecord, QName, Sort' Term, Args, Args)
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCM m) =>
    TypeError -> m a
    hardTypeError (TypeError
     -> ExceptT TCErr m (DataOrRecord, QName, Sort' Term, Args, Args))
    -> ExceptT TCErr m TypeError
    -> ExceptT TCErr m (DataOrRecord, QName, Sort' Term, 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, Sort' Term, Args, Args)
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCM m) =>
    TypeError -> m a
    hardTypeError (TypeError
     -> ExceptT TCErr m (DataOrRecord, QName, Sort' Term, Args, Args))
    -> TypeError
    -> ExceptT TCErr m (DataOrRecord, QName, Sort' Term, Args, Args)
    forall a b. (a -> b) -> a -> b
    $ QName -> TypeError
    SplitOnUnchecked QName
    d

          -- 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, Sort' Term, Args, Args)
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCM m) =>
    TypeError -> m a
    hardTypeError (TypeError
     -> ExceptT TCErr m (DataOrRecord, QName, Sort' Term, Args, Args))
    -> ExceptT TCErr m TypeError
    -> ExceptT TCErr m (DataOrRecord, QName, Sort' Term, 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, Sort' Term, 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, Sort' Term, Args, Args)
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCM m) =>
    TypeError -> m a
    hardTypeError (TypeError
     -> ExceptT TCErr m (DataOrRecord, QName, Sort' Term, Args, Args))
    -> ExceptT TCErr m TypeError
    -> ExceptT TCErr m (DataOrRecord, QName, Sort' Term, 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, Sort' Term, Args, Args)
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCM m) =>
    TypeError -> m a
    hardTypeError (TypeError
     -> ExceptT TCErr m (DataOrRecord, QName, Sort' Term, Args, Args))
    -> ExceptT TCErr m TypeError
    -> ExceptT TCErr m (DataOrRecord, QName, Sort' Term, 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, Sort' Term, Args, Args)
    forall a. HasCallStack => a
    __IMPOSSIBLE__

        -- variable: fail softly
        Var{}      -> TypeError
    -> ExceptT TCErr m (DataOrRecord, QName, Sort' Term, Args, Args)
    forall (m :: * -> *) a.
    (HasCallStack, ReadTCState m, MonadError TCErr m, MonadTCEnv m) =>
    TypeError -> m a
    softTypeError (TypeError
     -> ExceptT TCErr m (DataOrRecord, QName, Sort' Term, Args, Args))
    -> ExceptT TCErr m TypeError
    -> ExceptT TCErr m (DataOrRecord, QName, Sort' Term, 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, Sort' Term, Args, Args)
    forall a. HasCallStack => a
    __IMPOSSIBLE__  -- That is handled in @blocked@.

        -- pi or sort: fail hard
        Pi{}       -> TypeError
    -> ExceptT TCErr m (DataOrRecord, QName, Sort' Term, Args, Args)
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCM m) =>
    TypeError -> m a
    hardTypeError (TypeError
     -> ExceptT TCErr m (DataOrRecord, QName, Sort' Term, Args, Args))
    -> ExceptT TCErr m TypeError
    -> ExceptT TCErr m (DataOrRecord, QName, Sort' Term, 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, Sort' Term, Args, Args)
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCM m) =>
    TypeError -> m a
    hardTypeError (TypeError
     -> ExceptT TCErr m (DataOrRecord, QName, Sort' Term, Args, Args))
    -> ExceptT TCErr m TypeError
    -> ExceptT TCErr m (DataOrRecord, QName, Sort' Term, 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, Sort' Term, Args, Args)
    forall a. HasCallStack => a
    __IMPOSSIBLE__
        Lit{}      -> ExceptT TCErr m (DataOrRecord, QName, Sort' Term, Args, Args)
    forall a. HasCallStack => a
    __IMPOSSIBLE__
        Con{}      -> ExceptT TCErr m (DataOrRecord, QName, Sort' Term, Args, Args)
    forall a. HasCallStack => a
    __IMPOSSIBLE__
        Level{}    -> ExceptT TCErr m (DataOrRecord, QName, Sort' Term, Args, Args)
    forall a. HasCallStack => a
    __IMPOSSIBLE__
        DontCare{} -> ExceptT TCErr m (DataOrRecord, QName, Sort' Term, Args, Args)
    forall a. HasCallStack => a
    __IMPOSSIBLE__
        Dummy [Char]
    s Elims
    _  -> [Char]
    -> ExceptT TCErr m (DataOrRecord, QName, Sort' Term, 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, Sort' Term, Args, Args)
    forall (m :: * -> *) a.
    (HasCallStack, ReadTCState m, MonadError TCErr m, MonadTCEnv m) =>
    TypeError -> m a
    softTypeError (TypeError
     -> ExceptT TCErr m (DataOrRecord, QName, Sort' Term, Args, Args))
    -> ExceptT TCErr m TypeError
    -> ExceptT TCErr m (DataOrRecord, QName, Sort' Term, 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, Sort' Term, Args, Args)
    forall (m :: * -> *) a.
    (HasCallStack, ReadTCState m, MonadError TCErr m, MonadTCEnv m) =>
    TypeError -> m a
    softTypeError (TypeError
     -> ExceptT TCErr m (DataOrRecord, QName, Sort' Term, Args, Args))
    -> ExceptT TCErr m TypeError
    -> ExceptT TCErr m (DataOrRecord, QName, Sort' Term, 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, Sort' Term, Args, Args)
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCM m) =>
    TypeError -> m a
    hardTypeError (TypeError
     -> ExceptT TCErr m (DataOrRecord, QName, Sort' Term, Args, Args))
    -> ExceptT TCErr m TypeError
    -> ExceptT TCErr m (DataOrRecord, QName, Sort' Term, 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, Sort' Term, Args, Args)
    forall a. HasCallStack => a
    __IMPOSSIBLE__

      where
      notData :: ExceptT TCErr m TypeError
    notData      = TCM TypeError -> ExceptT TCErr m TypeError
    forall a. TCM a -> ExceptT TCErr m a
    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, Sort' Term, Args, Args)
    blocked Blocker
    b Type
    _a = TypeError
    -> ExceptT TCErr m (DataOrRecord, QName, Sort' Term, Args, Args)
    forall (m :: * -> *) a.
    (HasCallStack, ReadTCState m, MonadError TCErr m, MonadTCEnv m) =>
    TypeError -> m a
    softTypeError (TypeError
     -> ExceptT TCErr m (DataOrRecord, QName, Sort' Term, Args, Args))
    -> ExceptT TCErr m TypeError
    -> ExceptT TCErr m (DataOrRecord, QName, Sort' Term, Args, Args)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< do TCM TypeError -> ExceptT TCErr m TypeError
    forall a. TCM a -> ExceptT TCErr m a
    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
      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 a b. TCMT IO a -> (a -> TCMT IO b) -> TCMT IO b
    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 a. a -> TCMT IO a
    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
      b <- (`piApply` pars) . defType <$> getConstInfo (conName con)
      return (con, 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.
      TCMT IO (Maybe (QName, Args, RecordData))
    -> TCM (QName, Bool, QName, Arg Type, ArgInfo)
    -> ((QName, Args, RecordData)
        -> 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 (TCMT IO (Maybe (QName, Args, RecordData))
    -> TCMT IO (Maybe (QName, Args, RecordData))
    forall a. TCM a -> TCM a
    forall (tcm :: * -> *) a. MonadTCM tcm => TCM a -> tcm a
    liftTCM (TCMT IO (Maybe (QName, Args, RecordData))
     -> TCMT IO (Maybe (QName, Args, RecordData)))
    -> TCMT IO (Maybe (QName, Args, RecordData))
    -> TCMT IO (Maybe (QName, Args, RecordData))
    forall a b. (a -> b) -> a -> b
    $ Type -> TCMT IO (Maybe (QName, Args, RecordData))
    forall (m :: * -> *).
    PureTCM m =>
    Type -> m (Maybe (QName, Args, RecordData))
    isRecordType (Type -> TCMT IO (Maybe (QName, Args, RecordData)))
    -> Type -> TCMT IO (Maybe (QName, Args, RecordData))
    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
    r, Args
    vs, RecordData{ _recFields :: RecordData -> [Dom' Term QName]
    _recFields = [Dom' Term QName]
    fs, _recInduction :: RecordData -> Maybe Induction
    _recInduction = Maybe Induction
    ind, _recEtaEquality' :: RecordData -> 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
            [ TCMT IO Doc
    "we are of record type r  = " TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall a. Semigroup a => a -> a -> a
    <> Doc -> TCMT IO Doc
    forall a. a -> TCMT IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (QName -> Doc
    forall a. Pretty a => a -> Doc
    P.pretty QName
    r)
            , TCMT IO Doc
    "applied to parameters vs = " TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall a. Semigroup a => a -> a -> a
    <> Args -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    forall (m :: * -> *). MonadPretty m => Args -> m Doc
    prettyTCM Args
    vs
            , TCMT IO Doc
    "and have fields       fs = " TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall a. Semigroup a => a -> a -> a
    <> Doc -> TCMT IO Doc
    forall a. a -> TCMT IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ([Arg QName] -> Doc
    forall a. Pretty a => a -> Doc
    P.pretty ([Arg QName] -> Doc) -> [Arg QName] -> Doc
    forall a b. (a -> b) -> a -> b
    $ (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
    ind 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
                (TCErr
    err:[TCErr]
    _, [] ) -> TCErr -> TCM (QName, Bool, QName, Arg Type, ArgInfo)
    forall a. TCErr -> TCMT IO a
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError TCErr
    err
                ([]   , [] ) -> TCM (QName, Bool, QName, Arg Type, ArgInfo)
    forall a. HasCallStack => a
    __IMPOSSIBLE__
                ([TCErr]
    _    , [(QName, (Arg Type, ArgInfo, Maybe TCState))
    _]) -> TCM (QName, Bool, QName, Arg Type, ArgInfo)
    forall a. HasCallStack => a
    __IMPOSSIBLE__
                ([TCErr]
    _    , (QName
    d,(Arg Type, ArgInfo, Maybe TCState)
    _) : (QName
    d1,(Arg Type, ArgInfo, Maybe TCState)
    _) : [(QName, (Arg Type, ArgInfo, Maybe TCState))]
    disambs) ->
                  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))
    -> TypeError -> TCM (QName, Bool, QName, Arg Type, ArgInfo)
    forall a b. (a -> b) -> a -> b
    $ QName -> List1 QName -> TypeError
    AmbiguousProjection QName
    d (List1 QName -> TypeError) -> List1 QName -> TypeError
    forall a b. (a -> b) -> a -> b
    $ QName
    d1 QName -> [QName] -> List1 QName
    forall a. a -> [a] -> NonEmpty a
    :| ((QName, (Arg Type, ArgInfo, Maybe TCState)) -> QName)
    -> [(QName, (Arg Type, ArgInfo, Maybe TCState))] -> [QName]
    forall a b. (a -> b) -> [a] -> [b]
    map (QName, (Arg Type, ArgInfo, Maybe TCState)) -> QName
    forall a b. (a, b) -> a
    fst [(QName, (Arg Type, ArgInfo, Maybe TCState))]
    disambs
      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.
          disambiguations :: List1 (Either TCErr (QName, (Arg Type, ArgInfo, Maybe TCState)))
            <- (QName
     -> TCM (Either TCErr (QName, (Arg Type, ArgInfo, Maybe TCState))))
    -> List1 QName
    -> TCM
         (List1 (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)
    forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> NonEmpty a -> m (NonEmpty 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 List1.partitionEithers 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 a. TCM a -> TCM a
    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 a. a -> TCMT IO a
    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 a. TCM a -> m a
    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
    $ if AmbiguousQName -> Bool
    isAmbiguous AmbiguousQName
    ambD then Arg Type -> Bool -> QName -> TypeError
    CannotEliminateWithProjection Arg Type
    b Bool
    True (QName -> TypeError) -> TCMT IO QName -> TCM TypeError
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> QName -> TCMT IO QName
    forall (m :: * -> *). MonadPretty m => QName -> m QName
    dropTopLevelModule QName
    d
                    else TypeError -> TCM TypeError
    forall a. a -> TCMT IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (TypeError -> TCM TypeError) -> TypeError -> TCM TypeError
    forall a b. (a -> b) -> a -> b
    $ Arg Type -> Bool -> QName -> TypeError
    CannotEliminateWithProjection Arg Type
    b Bool
    False 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 a b.
    ExceptT TCErr (TCMT IO) a
    -> (a -> ExceptT TCErr (TCMT IO) b) -> ExceptT TCErr (TCMT IO) b
    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
            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 a. a -> ExceptT TCErr (TCMT IO) a
    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.
            when (null $ projLams proj) $ wrongProj d
            reportSLn "tc.lhs.split" 90 "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.
            reportSDoc "tc.lhs.split" 20 $ sep
              [ text $ "proj                  d0 = " ++ prettyShow d0
              , text $ "original proj         d  = " ++ prettyShow 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.
            argd <- maybe (wrongProj d) return $ List.find ((d ==) . unDom) 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 = Dom' Term QName -> ArgInfo
    forall a. LensArgInfo a => a -> ArgInfo
    getArgInfo Dom' Term QName
    argd

            reportSDoc "tc.lhs.split" 20 $ vcat
              [ text $ "original proj relevance  = " ++ show (getRelevance argd)
              , text $ "original proj quantity   = " ++ show (getQuantity  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.
            unless (caseMaybe h True $ sameHiding $ projArgInfo proj) $
              softTypeError $ WrongHidingInProjection d

            -- Andreas, 2016-12-31, issue #1976: Check parameters.
            let chk = QName -> QName -> Args -> TCMT IO ()
    forall (tcm :: * -> *).
    MonadTCM tcm =>
    QName -> QName -> Args -> tcm ()
    checkParameters QName
    qr QName
    r Args
    vs
            mst <- suspendErrors $
              if constraintsOk then Just . snd <$> localTCStateSaving chk
              else Nothing <$ nonConstraining chk

            -- Get the type of projection d applied to "self"
            dType <- liftTCM $ defType <$> getConstInfo d  -- full type!
            reportSDoc "tc.lhs.split" 20 $ sep
              [ "we are being projected by dType = " <+> prettyTCM dType
              ]
            projType <- liftTCM $ dType `piApplyM` vs
            return (d0, (Arg ai projType, projArgInfo proj, 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
      d <- QName -> TCMT IO QName
    forall (m :: * -> *). HasConstInfo m => QName -> m QName
    canonicalName QName
    d
      cons <- theDef <$> getConstInfo d >>= \case
        def :: Defn
    def@Datatype{} -> [QName] -> TCMT IO [QName]
    forall a. a -> TCMT IO a
    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 a. a -> TCMT IO a
    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.
      tryDisambiguate False d cons $ \ ([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 a. TCErr -> TCMT IO a
    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]
    _    , (d0 :: List1 (QName, ConHead, (Type, Maybe TCState))
    d0@((QName
    c,ConHead
    _,(Type, Maybe TCState)
    _) :| [(QName, ConHead, (Type, Maybe TCState))]
    _) : List1 (QName, ConHead, (Type, Maybe TCState))
    d1 : [List1 (QName, ConHead, (Type, Maybe TCState))]
    ds)) -> 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 -> List2 QName -> TypeError
    AmbiguousConstructor QName
    c (List2 QName -> TypeError) -> List2 QName -> TypeError
    forall a b. (a -> b) -> a -> b
    $ ((QName, ConHead, (Type, Maybe TCState)) -> QName)
    -> List2 (QName, ConHead, (Type, Maybe TCState)) -> List2 QName
    forall a b. (a -> b) -> List2 a -> List2 b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (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) (List2 (QName, ConHead, (Type, Maybe TCState)) -> List2 QName)
    -> List2 (QName, ConHead, (Type, Maybe TCState)) -> List2 QName
    forall a b. (a -> b) -> a -> b
    $ List2 (List1 (QName, ConHead, (Type, Maybe TCState)))
    -> List2 (QName, ConHead, (Type, Maybe TCState))
    forall a. List2 (List1 a) -> List2 a
    List2.concat21 (List2 (List1 (QName, ConHead, (Type, Maybe TCState)))
     -> List2 (QName, ConHead, (Type, Maybe TCState)))
    -> List2 (List1 (QName, ConHead, (Type, Maybe TCState)))
    -> List2 (QName, ConHead, (Type, Maybe TCState))
    forall a b. (a -> b) -> a -> b
    $ List1 (QName, ConHead, (Type, Maybe TCState))
    -> List1 (QName, ConHead, (Type, Maybe TCState))
    -> [List1 (QName, ConHead, (Type, Maybe TCState))]
    -> List2 (List1 (QName, ConHead, (Type, Maybe TCState)))
    forall a. a -> a -> [a] -> List2 a
    List2 List1 (QName, ConHead, (Type, Maybe TCState))
    d0 List1 (QName, ConHead, (Type, Maybe TCState))
    d1 [List1 (QName, ConHead, (Type, Maybe TCState))]
    ds

      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 -> [Item (List1 QName)]
    forall l. IsList l => l -> [Item l]
    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
            ]
          disambiguations <- (QName
     -> TCMT IO (Either TCErr (QName, ConHead, (Type, Maybe TCState))))
    -> List1 QName
    -> TCMT
         IO
         (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)
    forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> NonEmpty a -> m (NonEmpty b)
    mapM (ExceptT TCErr (TCMT IO) (QName, ConHead, (Type, Maybe TCState))
    -> TCMT IO (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))
     -> TCMT IO (Either TCErr (QName, ConHead, (Type, Maybe TCState))))
    -> (QName
        -> ExceptT TCErr (TCMT IO) (QName, ConHead, (Type, Maybe TCState)))
    -> QName
    -> TCMT IO (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 (errs, fits0) = List1.partitionEithers disambiguations
          reportSDoc "tc.lhs.disamb" 40 $ vcat $ do
            let 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 a b. a -> f b -> f a
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ f b
    mst))
            "remaining candidates: " : map (nest 2 . prettyTCM . hideSt) fits0
          dedupCons fits0 >>= \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
    forall (m :: * -> *). MonadPretty m => Type -> 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 b (m :: * -> *). (IsBool b, Monad m) => b -> m () -> m ()
    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 a. TCM a -> TCM a
    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 a. a -> TCMT IO a
    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 a b.
    ExceptT TCErr (TCMT IO) a
    -> (a -> ExceptT TCErr (TCMT IO) b) -> ExceptT TCErr (TCMT IO) b
    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
    SigCubicalNotErasure -> 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 b (m :: * -> *). (IsBool b, Monad m) => b -> m () -> m ()
    unless (ConHead -> QName
    conName ConHead
    con QName -> [QName] -> Bool
    forall a. Eq a => a -> [a] -> 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
            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 a b. a -> TCMT IO b -> TCMT IO a
    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?
            cType <- (`piApply` pars) . defType <$> getConInfo con

            return (c, con, (cType, 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 :: [NonEmpty (a, ConHead, (Type, Maybe TCState))]
    groups = ((a, ConHead, (Type, Maybe TCState)) -> QName)
    -> [(a, ConHead, (Type, Maybe TCState))]
    -> [NonEmpty (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.
          (NonEmpty (a, ConHead, (Type, Maybe TCState))
     -> TCMT IO (NonEmpty (a, ConHead, (Type, Maybe TCState))))
    -> [NonEmpty (a, ConHead, (Type, Maybe TCState))]
    -> TCMT IO [NonEmpty (a, ConHead, (Type, Maybe TCState))]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM (((a, ConHead, (Type, Maybe TCState))
     -> (a, ConHead, (Type, Maybe TCState)) -> TCMT IO Bool)
    -> NonEmpty (a, ConHead, (Type, Maybe TCState))
    -> TCMT IO (NonEmpty (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)) [NonEmpty (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 a. a -> TCMT IO a
    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

    -- | @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
      dc <- TCMT IO QName -> tcm QName
    forall a. TCM a -> tcm a
    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
      checkParameters dc d 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 a. TCM a -> tcm a
    forall (tcm :: * -> *) a. MonadTCM tcm => TCM a -> tcm a
    liftTCM (TCMT IO () -> tcm ()) -> TCMT IO () -> tcm ()
    forall a b. (a -> b) -> a -> b
    $ do
      a  <- Term -> TCMT IO Term
    forall a (m :: * -> *). (Reduce a, MonadReduce m) => a -> m a
    reduce (QName -> Elims -> Term
    Def QName
    dc [])
      case 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
    forall (m :: * -> *). MonadPretty m => Args -> 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
    forall (m :: * -> *). MonadPretty m => Args -> m Doc
    prettyTCM Args
    pars
            ]
          -- when (d0 /= d) __IMPOSSIBLE__ -- d could have extra qualification
          t <- QName -> TCMT IO Type
    forall (m :: * -> *).
    (HasConstInfo m, ReadTCState m) =>
    QName -> m Type
    typeOfConst QName
    d
          compareArgs [] [] t (Def d []) vs (take (length vs) 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 -> Telescope -> Maybe ty -> m ()
    checkSortOfSplitVar DataOrRecord
    dr a
    a Telescope
    tel Maybe ty
    mtarget = do
      let s :: Sort' Term
    s = a -> Sort' Term
    forall a. LensSort a => a -> Sort' Term
    getSort a
    a
      sa <- TCM (Sort' Term) -> m (Sort' Term)
    forall a. TCM a -> m a
    forall (tcm :: * -> *) a. MonadTCM tcm => TCM a -> tcm a
    liftTCM (TCM (Sort' Term) -> m (Sort' Term))
    -> TCM (Sort' Term) -> m (Sort' Term)
    forall a b. (a -> b) -> a -> b
    $ Sort' Term -> TCM (Sort' Term)
    forall a (m :: * -> *). (Reduce a, MonadReduce m) => a -> m a
    reduce Sort' Term
    s
      case sortUniv sa of
        Just UType{} -> m Bool -> m () -> m ()
    forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
    whenM m Bool
    forall (m :: * -> *). HasOptions m => m Bool
    isTwoLevelEnabled m ()
    checkFibrantSplit
        Just UProp{} -> m ()
    checkPropSplit
        Just USSet{} -> () -> m ()
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
        Maybe Univ
    Nothing      -> 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 a. TCM a -> m a
    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 a b. TCMT IO (a -> b) -> TCMT IO a -> TCMT IO b
    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
    forall (m :: * -> *). MonadPretty m => Sort' Term -> m Doc
    prettyTCM Sort' Term
    s]

      where
        checkPropSplit :: m ()
    checkPropSplit
          | IsRecord InductionAndEta { recordInduction :: InductionAndEta -> Maybe Induction
    recordInduction=Maybe Induction
    Nothing } <- DataOrRecord
    dr = () -> m ()
    forall a. a -> m a
    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
    forall (m :: * -> *). MonadPretty m => ty -> 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 :: * -> *} {a}.
    (ReadTCState m, MonadError TCErr m, MonadTCEnv m) =>
    DataOrRecord -> m a
    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 a b. m a -> (a -> m b) -> m b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \case
          Left Blocker
    b      -> DataOrRecord -> m ()
    forall {m :: * -> *} {a}.
    (ReadTCState m, MonadError TCErr m, MonadTCEnv m) =>
    DataOrRecord -> m a
    splitOnPropError DataOrRecord
    dr -- TODO
          Right Bool
    False -> DataOrRecord -> m ()
    forall {m :: * -> *} {a}.
    (ReadTCState m, MonadError TCErr m, MonadTCEnv m) =>
    DataOrRecord -> m a
    splitOnPropError DataOrRecord
    dr
          Right Bool
    True  -> () -> m ()
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

        checkFibrantSplit :: m ()
    checkFibrantSplit
          | IsRecord InductionAndEta
    _ <- DataOrRecord
    dr       = () -> m ()
    forall a. a -> m a
    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
    forall (m :: * -> *). MonadPretty m => ty -> 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_ (Telescope -> [Dom ([Char], Type)]
    forall t. Tele (Dom t) -> [Dom ([Char], t)]
    telToList Telescope
    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 = Type -> m (Either Blocker Bool)
    forall a (m :: * -> *).
    (LensSort a, PureTCM m) =>
    a -> m (Either Blocker Bool)
    isCoFibrantSort Type
    t m (Either Blocker Bool) -> (Either Blocker Bool -> m ()) -> m ()
    forall a b. m a -> (a -> m b) -> m b
    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 a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

        checkIsFibrant :: ty -> m ()
    checkIsFibrant ty
    t = ty -> m (Either Blocker Bool)
    forall a (m :: * -> *).
    (LensSort a, PureTCM m) =>
    a -> m (Either Blocker Bool)
    isFibrant' ty
    t m (Either Blocker Bool) -> (Either Blocker Bool -> m ()) -> m ()
    forall a b. m a -> (a -> m b) -> m b
    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 a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

        splitOnPropError :: DataOrRecord -> m a
    splitOnPropError DataOrRecord
    dr = 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
    $ DataOrRecord -> TypeError
    SplitInProp DataOrRecord
    dr

        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 a. TCM a -> m a
    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
    forall (m :: * -> *). 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
    forall (m :: * -> *). MonadPretty m => Type -> 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 a. TCM a -> m a
    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
    forall (m :: * -> *). MonadPretty m => a -> m Doc
    prettyTCM a
    a
            , TCMT IO Doc
    "unless target type is also fibrant"
            ]