    {-# LANGUAGE NondecreasingIndentation #-}

    module Agda.TypeChecking.Rules.Data where

    import Prelude hiding (null, not, (&&), (||) )

    import Control.Monad.Except ( MonadError(..), ExceptT(..), runExceptT )
    import Control.Monad.Trans.Maybe
    import Control.Exception as E

    import Data.Set (Set)
    import qualified Data.Set as Set

    import Agda.Interaction.Options.Base

    import qualified Agda.Syntax.Abstract as A
    import qualified Agda.Syntax.Concrete.Name as C
    import Agda.Syntax.Abstract.Views (deepUnscope)
    import Agda.Syntax.Internal
    import Agda.Syntax.Internal.Pattern
    import Agda.Syntax.Common
    import qualified Agda.Syntax.Common.Pretty as P
    import Agda.Syntax.Position
    import qualified Agda.Syntax.Info as Info
    import Agda.Syntax.Scope.Monad

    import {-# SOURCE #-} Agda.TypeChecking.CompiledClause.Compile
    import Agda.TypeChecking.Monad
    import Agda.TypeChecking.Conversion
    import {-# SOURCE #-} Agda.TypeChecking.CheckInternal
    import Agda.TypeChecking.Substitute
    import Agda.TypeChecking.Generalize
    import Agda.TypeChecking.Implicit
    import Agda.TypeChecking.InstanceArguments
    import Agda.TypeChecking.MetaVars
    import Agda.TypeChecking.Names
    import Agda.TypeChecking.Reduce
    import Agda.TypeChecking.Positivity.Occurrence (Occurrence(StrictPos))
    import Agda.TypeChecking.Pretty
    import Agda.TypeChecking.Primitive hiding (Nat)
    import Agda.TypeChecking.Free
    import Agda.TypeChecking.Forcing
    import Agda.TypeChecking.Irrelevance
    import Agda.TypeChecking.Telescope
    import Agda.TypeChecking.Warnings (warning)

    import {-# SOURCE #-} Agda.TypeChecking.Rules.Term ( isType_ )

    import Agda.Utils.Boolean
    import Agda.Utils.Either
    import Agda.Utils.Function (applyWhen)
    import Agda.Utils.Functor
    import Agda.Utils.List
    import Agda.Utils.Maybe
    import Agda.Utils.Monad
    import Agda.Utils.Null
    import qualified Agda.Utils.Set1 as Set1
    import Agda.Utils.Size

    import Agda.Utils.Impossible

    ---------------------------------------------------------------------------
    -- * Datatypes
    ---------------------------------------------------------------------------

    -- | Type check a datatype definition. Assumes that the type has already been
    --   checked.
    checkDataDef :: A.DefInfo -> QName -> UniverseCheck -> A.DataDefParams -> [A.Constructor] -> TCM ()
    checkDataDef :: DefInfo
    -> QName
    -> UniverseCheck
    -> DataDefParams
    -> [Constructor]
    -> TCM ()
    checkDataDef DefInfo
    i QName
    name UniverseCheck
    uc (A.DataDefParams Set Name
    gpars [LamBinding]
    ps) [Constructor]
    cs =
        Call -> TCM () -> TCM ()
    forall a. Call -> TCMT IO a -> TCMT IO a
    forall (m :: * -> *) a. MonadTrace m => Call -> m a -> m a
    traceCall (Range -> QName -> [LamBinding] -> [Constructor] -> Call
    CheckDataDef (QName -> Range
    forall a. HasRange a => a -> Range
    getRange QName
    name) QName
    name [LamBinding]
    ps [Constructor]
    cs) (TCM () -> TCM ()) -> TCM () -> TCM ()
    forall a b. (a -> b) -> a -> b
    $ do

            -- Add the datatype module
            ModuleName -> TCM ()
    addSection (QName -> ModuleName
    qnameToMName QName
    name)

            -- Look up the type of the datatype.
            def <- Definition -> TCMT IO Definition
    forall (m :: * -> *).
    (Functor m, HasConstInfo m, HasOptions m, ReadTCState m,
     MonadTCEnv m, MonadDebug m) =>
    Definition -> m Definition
    instantiateDef (Definition -> TCMT IO Definition)
    -> TCMT IO Definition -> TCMT IO Definition
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< QName -> TCMT IO Definition
    forall (m :: * -> *). HasConstInfo m => QName -> m Definition
    getConstInfo QName
    name
            t   <- instantiateFull $ defType def
            let npars =
                  case Definition -> Defn
    theDef Definition
    def of
                    DataOrRecSig Nat
    n -> Nat
    n
                    Defn
    _              -> Nat
    forall a. HasCallStack => a
    __IMPOSSIBLE__

            -- If the data type is erased, then hard compile-time mode is
            -- entered.
            setHardCompileTimeModeIfErased' def $ do

            -- Make sure the shape of the type is visible
            let unTelV (TelV Tele (Dom Type)
    tel Type
    a) = Tele (Dom Type) -> Type -> Type
    telePi Tele (Dom Type)
    tel Type
    a
            t <- unTelV <$> telView t

            parNames <- getGeneralizedParameters gpars name

            -- Top level free vars
            freeVars <- getContextSize

            -- The parameters are in scope when checking the constructors.
            dataDef <- bindGeneralizedParameters parNames t $ \ Tele (Dom Type)
    gtel Type
    t0 ->
                       Nat
    -> [LamBinding]
    -> Type
    -> (Tele (Dom Type) -> Type -> TCM DatatypeData)
    -> TCM DatatypeData
    forall a.
    Nat
    -> [LamBinding]
    -> Type
    -> (Tele (Dom Type) -> Type -> TCM a)
    -> TCM a
    bindParameters (Nat
    npars Nat -> Nat -> Nat
    forall a. Num a => a -> a -> a
    - [Maybe Name] -> Nat
    forall a. [a] -> Nat
    forall (t :: * -> *) a. Foldable t => t a -> Nat
    length [Maybe Name]
    parNames) [LamBinding]
    ps Type
    t0 ((Tele (Dom Type) -> Type -> TCM DatatypeData) -> TCM DatatypeData)
    -> (Tele (Dom Type) -> Type -> TCM DatatypeData)
    -> TCM DatatypeData
    forall a b. (a -> b) -> a -> b
    $ \ Tele (Dom Type)
    ptel Type
    t0 -> do

                -- The type we get from bindParameters is Θ -> s where Θ is the type of
                -- the indices. We count the number of indices and return s.
                -- We check that s is a sort.
                let TelV Tele (Dom Type)
    ixTel Type
    s0 = Type -> TelV Type
    telView' Type
    t0
                    nofIxs :: Nat
    nofIxs = Tele (Dom Type) -> Nat
    forall a. Sized a => a -> Nat
    size Tele (Dom Type)
    ixTel

                s <- TCMT IO (Sort' Term) -> TCMT IO (Sort' Term)
    forall (m :: * -> *) a.
    (MonadTCEnv m, HasOptions m, MonadDebug m) =>
    m a -> m a
    workOnTypes (TCMT IO (Sort' Term) -> TCMT IO (Sort' Term))
    -> TCMT IO (Sort' Term) -> TCMT IO (Sort' Term)
    forall a b. (a -> b) -> a -> b
    $ do
                  -- Andreas, 2016-11-02 issue #2290
                  -- Trying to unify the sort with a fresh sort meta which is
                  -- defined outside the index telescope is the most robust way
                  -- to check independence of the indices.
                  -- However, it might give the dreaded "Cannot instantiate meta..."
                  -- error which we replace by a more understandable error
                  -- in case of a suspected dependency.
                  s <- TCMT IO (Sort' Term)
    newSortMetaBelowInf
                  catchError_ (addContext ixTel $ equalType s0 $ raise nofIxs $ sort s) $ \ TCErr
    err ->
                      if (Nat -> Bool) -> [Nat] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any (Nat -> Type -> Bool
    forall a. Free a => Nat -> a -> Bool
    `freeIn` Type
    s0) [Nat
    0..Nat
    nofIxs Nat -> Nat -> Nat
    forall a. Num a => a -> a -> a
    - Nat
    1] then TypeError -> TCM ()
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCError m) =>
    TypeError -> m a
    typeError (TypeError -> TCM ()) -> TypeError -> TCM ()
    forall a b. (a -> b) -> a -> b
    $ QName -> Type -> TypeError
    SortCannotDependOnItsIndex QName
    name Type
    t0
                      else TCErr -> TCM ()
    forall a. TCErr -> TCMT IO a
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError TCErr
    err
                  reduce s

                withK   <- not <$> withoutKOption
                erasure <- optErasure <$> pragmaOptions
                -- Parameters are always hidden in constructors. If
                -- --erasure is used, then the parameters are erased for
                -- non-indexed data types, and if --with-K is active this
                -- applies also to indexed data types.
                let tel  = Tele (Dom Type) -> Tele (Dom Type) -> Tele (Dom Type)
    forall t. Abstract t => Tele (Dom Type) -> t -> t
    abstract Tele (Dom Type)
    gtel Tele (Dom Type)
    ptel
                    tel' = Bool -> (Dom Type -> Dom Type) -> Dom Type -> Dom Type
    forall b a. IsBool b => b -> (a -> a) -> a -> a
    applyWhen (Bool
    erasure Bool -> Bool -> Bool
    forall a. Boolean a => a -> a -> a
    && (Bool
    withK Bool -> Bool -> Bool
    forall a. Boolean a => a -> a -> a
    || Nat
    nofIxs Nat -> Nat -> Bool
    forall a. Eq a => a -> a -> Bool
    == Nat
    0)) (Quantity -> Dom Type -> Dom Type
    forall a. LensQuantity a => Quantity -> a -> a
    applyQuantity Quantity
    zeroQuantity) (Dom Type -> Dom Type)
    -> (Dom Type -> Dom Type) -> Dom Type -> Dom Type
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
                           Dom Type -> Dom Type
    forall a. (LensHiding a, LensRelevance a) => a -> a
    hideAndRelParams (Dom Type -> Dom Type) -> Tele (Dom Type) -> Tele (Dom Type)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$>
                           Tele (Dom Type)
    tel

                reportSDoc "tc.data.sort" 20 $ vcat
                  [ "checking datatype" <+> prettyTCM name
                  , nest 2 $ vcat
                    [ "type (parameters instantiated):   " <+> prettyTCM t0
                    , "type (full):   " <+> prettyTCM t
                    , "sort:   " <+> prettyTCM s
                    , "indices:" <+> text (show nofIxs)
                    , "gparams:" <+> text (show parNames)
                    , "params: " <+> text (show $ deepUnscope ps)
                    ]
                  ]
                let npars = Tele (Dom Type) -> Nat
    forall a. Sized a => a -> Nat
    size Tele (Dom Type)
    tel

                -- Change the datatype from an axiom to a datatype with no constructors.
                let dataDef = DatatypeData
                      { _dataPars :: Nat
    _dataPars       = Nat
    npars
                      , _dataIxs :: Nat
    _dataIxs        = Nat
    nofIxs
                      , _dataClause :: Maybe Clause
    _dataClause     = Maybe Clause
    forall a. Maybe a
    Nothing
                      , _dataCons :: [QName]
    _dataCons       = []     -- Constructors are added later
                      , _dataSort :: Sort' Term
    _dataSort       = Sort' Term
    s
                      , _dataAbstr :: IsAbstract
    _dataAbstr      = DefInfo -> IsAbstract
    forall t. DefInfo' t -> IsAbstract
    Info.defAbstract DefInfo
    i
                      , _dataMutual :: Maybe [QName]
    _dataMutual     = Maybe [QName]
    forall a. Maybe a
    Nothing
                      , _dataPathCons :: [QName]
    _dataPathCons   = []     -- Path constructors are added later
                      , _dataTranspIx :: Maybe QName
    _dataTranspIx   = Maybe QName
    forall a. Maybe a
    Nothing -- Generated later if nofIxs > 0.
                      , _dataTransp :: Maybe QName
    _dataTransp     = Maybe QName
    forall a. Maybe a
    Nothing -- Added later
                      }

                escapeContext impossible npars $ do
                  addConstant' name defaultArgInfo t $ DatatypeDefn dataDef
                    -- polarity and argOcc.s determined by the positivity checker

                -- Check the types of the constructors
                pathCons <- forM cs $ \ Constructor
    c -> do
                  isPathCons <- QName
    -> UniverseCheck
    -> Tele (Dom Type)
    -> Nat
    -> Sort' Term
    -> Constructor
    -> TCM IsPathCons
    checkConstructor QName
    name UniverseCheck
    uc Tele (Dom Type)
    tel' Nat
    nofIxs Sort' Term
    s Constructor
    c
                  return $ if isPathCons == PathCons then Just (A.axiomName c) else Nothing

                -- cubical: the interval universe does not contain datatypes
                -- similar: SizeUniv, ...
                checkDataSort name s

                -- when `--without-K`, all the indices should fit in the
                -- sort of the datatype (see #3420).
                -- Andreas, 2019-07-16, issue #3916:
                -- NoUniverseCheck should also disable the index sort check!
                unless (uc == NoUniverseCheck) $
                  whenM withoutKOption $ do
                    let s' = case Sort' Term
    s of
                          Prop Level
    l -> Level -> Sort' Term
    forall t. Level' t -> Sort' t
    Type Level
    l
                          Sort' Term
    _      -> Sort' Term
    s
                    checkIndexSorts s' ixTel

                -- Return the data definition
                return dataDef{ _dataPathCons = catMaybes pathCons
                              }

            let cons   = (Constructor -> QName) -> [Constructor] -> [QName]
    forall a b. (a -> b) -> [a] -> [b]
    map Constructor -> QName
    A.axiomName [Constructor]
    cs  -- get constructor names

            (mtranspix, transpFun) <-
              ifM cubicalCompatibleOption
                (do mtranspix <- inTopContext $ defineTranspIx name
                    transpFun <- inTopContext $
                                   defineTranspFun name mtranspix cons
                                     (_dataPathCons dataDef)
                    return (mtranspix, transpFun))
                (return (Nothing, Nothing))

            -- Add the datatype to the signature with its constructors.
            -- It was previously added without them.
            addConstant' name defaultArgInfo t $ DatatypeDefn
                dataDef{ _dataCons = cons
                       , _dataTranspIx = mtranspix
                       , _dataTransp   = transpFun
                       }

    -- | Make sure that the target universe admits data type definitions.
    --   E.g. @IUniv@, @SizeUniv@ etc. do not accept new constructions.
    checkDataSort :: QName -> Sort -> TCM ()
    checkDataSort :: QName -> Sort' Term -> TCM ()
    checkDataSort QName
    name Sort' Term
    s = QName -> TCM () -> TCM ()
    forall (m :: * -> *) x a.
    (MonadTrace m, HasRange x) =>
    x -> m a -> m a
    setCurrentRange QName
    name (TCM () -> TCM ()) -> TCM () -> TCM ()
    forall a b. (a -> b) -> a -> b
    $ do
      Sort' Term
    -> (Blocker -> Sort' Term -> TCM ())
    -> (NotBlocked -> Sort' Term -> TCM ())
    -> TCM ()
    forall t (m :: * -> *) a.
    (Reduce t, IsMeta t, MonadReduce m) =>
    t -> (Blocker -> t -> m a) -> (NotBlocked -> t -> m a) -> m a
    ifBlocked Sort' Term
    s Blocker -> Sort' Term -> TCM ()
    postpone {-else-} ((NotBlocked -> Sort' Term -> TCM ()) -> TCM ())
    -> (NotBlocked -> Sort' Term -> TCM ()) -> TCM ()
    forall a b. (a -> b) -> a -> b
    $ \ NotBlocked
    _ (Sort' Term
    s :: Sort) -> do
        let
          yes :: TCM ()
          yes :: TCM ()
    yes = () -> TCM ()
    forall a. a -> TCMT IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
          no  :: TCM ()
          no :: TCM ()
    no  = TypeError -> TCM ()
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCError m) =>
    TypeError -> m a
    typeError (TypeError -> TCM ()) -> TypeError -> TCM ()
    forall a b. (a -> b) -> a -> b
    $ QName -> Sort' Term -> TypeError
    SortDoesNotAdmitDataDefinitions QName
    name Sort' Term
    s
        case Sort' Term
    s of
          -- Sorts that admit data definitions.
          Univ Univ
    _ Level
    _     -> TCM ()
    yes
          Inf Univ
    _ Integer
    _      -> TCM ()
    yes
          DefS QName
    _ [Elim' Term]
    _     -> TCM ()
    yes
          -- Sorts that do not admit data definitions.
          Sort' Term
    SizeUniv     -> TCM ()
    no
          Sort' Term
    LockUniv     -> TCM ()
    no
          Sort' Term
    LevelUniv    -> TCM ()
    no
          Sort' Term
    IntervalUniv -> TCM ()
    no
          -- Blocked sorts.
          PiSort Dom' Term Term
    _ Sort' Term
    _ Abs (Sort' Term)
    _ -> TCM ()
    forall a. HasCallStack => a
    __IMPOSSIBLE__
          FunSort Sort' Term
    _ Sort' Term
    _  -> TCM ()
    forall a. HasCallStack => a
    __IMPOSSIBLE__
          UnivSort Sort' Term
    _   -> TCM ()
    forall a. HasCallStack => a
    __IMPOSSIBLE__
          MetaS MetaId
    _ [Elim' Term]
    _    -> TCM ()
    forall a. HasCallStack => a
    __IMPOSSIBLE__
          DummyS String
    _     -> TCM ()
    forall a. HasCallStack => a
    __IMPOSSIBLE__
      where
        postpone :: Blocker -> Sort -> TCM ()
        postpone :: Blocker -> Sort' Term -> TCM ()
    postpone Blocker
    b Sort' Term
    s = Blocker -> Constraint -> TCM ()
    forall (m :: * -> *).
    MonadConstraint m =>
    Blocker -> Constraint -> m ()
    addConstraint Blocker
    b (Constraint -> TCM ()) -> Constraint -> TCM ()
    forall a b. (a -> b) -> a -> b
    $ QName -> Sort' Term -> Constraint
    CheckDataSort QName
    name Sort' Term
    s

    -- | Ensure that the type is a sort.
    --   If it is not directly a sort, compare it to a 'newSortMetaBelowInf'.
    forceSort :: Type -> TCM Sort
    forceSort :: Type -> TCMT IO (Sort' Term)
    forceSort Type
    t = Term -> TCMT IO Term
    forall a (m :: * -> *). (Reduce a, MonadReduce m) => a -> m a
    reduce (Type -> Term
    forall t a. Type'' t a -> a
    unEl Type
    t) TCMT IO Term
    -> (Term -> TCMT IO (Sort' Term)) -> TCMT IO (Sort' 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
    >>= \case
      Sort Sort' Term
    s -> Sort' Term -> TCMT IO (Sort' Term)
    forall a. a -> TCMT IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Sort' Term
    s
      Term
    _      -> do
        s <- TCMT IO (Sort' Term)
    newSortMetaBelowInf
        equalType t (sort s)
        return s

    -- | Type check a constructor declaration. Checks that the constructor targets
    --   the datatype and that it fits inside the declared sort.
    --   Returns the non-linear parameters.
    checkConstructor
      :: QName         -- ^ Name of data type.
      -> UniverseCheck -- ^ Check universes?
      -> Telescope     -- ^ Parameter telescope.
      -> Nat           -- ^ Number of indices of the data type.
      -> Sort          -- ^ Sort of the data type.
      -> A.Constructor -- ^ Constructor declaration (type signature).
      -> TCM IsPathCons
    checkConstructor :: QName
    -> UniverseCheck
    -> Tele (Dom Type)
    -> Nat
    -> Sort' Term
    -> Constructor
    -> TCM IsPathCons
    checkConstructor QName
    d UniverseCheck
    uc Tele (Dom Type)
    tel Nat
    nofIxs Sort' Term
    s (A.ScopedDecl ScopeInfo
    scope [Constructor
    con]) = do
      ScopeInfo -> TCM ()
    setScope ScopeInfo
    scope
      QName
    -> UniverseCheck
    -> Tele (Dom Type)
    -> Nat
    -> Sort' Term
    -> Constructor
    -> TCM IsPathCons
    checkConstructor QName
    d UniverseCheck
    uc Tele (Dom Type)
    tel Nat
    nofIxs Sort' Term
    s Constructor
    con
    checkConstructor QName
    d UniverseCheck
    uc Tele (Dom Type)
    tel Nat
    nofIxs Sort' Term
    s con :: Constructor
    con@(A.Axiom KindOfName
    _ DefInfo
    i ArgInfo
    ai Maybe PragmaPolarities
    Nothing QName
    c Type
    e) =
        Call -> TCM IsPathCons -> TCM IsPathCons
    forall a. Call -> TCMT IO a -> TCMT IO a
    forall (m :: * -> *) a. MonadTrace m => Call -> m a -> m a
    traceCall (QName -> Tele (Dom Type) -> Sort' Term -> Constructor -> Call
    CheckConstructor QName
    d Tele (Dom Type)
    tel Sort' Term
    s Constructor
    con) (TCM IsPathCons -> TCM IsPathCons)
    -> TCM IsPathCons -> TCM IsPathCons
    forall a b. (a -> b) -> a -> b
    $ do
    {- WRONG
          -- Andreas, 2011-04-26: the following happens to the right of ':'
          -- we may use irrelevant arguments in a non-strict way in types
          t' <- workOnTypes $ do
    -}
            QName -> Type -> TCM ()
    forall {m :: * -> *} {a} {a}.
    (MonadDebug m, PrettyTCM a, PrettyTCM a) =>
    a -> a -> m ()
    debugEnter QName
    c Type
    e
            -- Remember that we are of a suitable modality.
            Bool -> TCM () -> TCM ()
    forall b (m :: * -> *). (IsBool b, Monad m) => b -> m () -> m ()
    unless (ArgInfo -> Bool
    forall a. LensRelevance a => a -> Bool
    isRelevant ArgInfo
    ai) TCM ()
    forall a. HasCallStack => a
    __IMPOSSIBLE__
            Bool -> TCM () -> TCM ()
    forall b (m :: * -> *). (IsBool b, Monad m) => b -> m () -> m ()
    unless ((ArgInfo -> Bool
    forall a. LensQuantity a => a -> Bool
    isQuantityω (ArgInfo -> Bool) -> (ArgInfo -> Bool) -> ArgInfo -> Bool
    forall a. Boolean a => a -> a -> a
    || ArgInfo -> Bool
    forall a. LensQuantity a => a -> Bool
    isQuantity0) ArgInfo
    ai) TCM ()
    forall a. HasCallStack => a
    __IMPOSSIBLE__

            -- If the constructor is erased, then hard compile-time mode
            -- is entered.
            ArgInfo -> TCM IsPathCons -> TCM IsPathCons
    forall q a. LensQuantity q => q -> TCM a -> TCM a
    setHardCompileTimeModeIfErased' ArgInfo
    ai (TCM IsPathCons -> TCM IsPathCons)
    -> TCM IsPathCons -> TCM IsPathCons
    forall a b. (a -> b) -> a -> b
    $ do

            -- check that the type of the constructor is well-formed
            (t, isPathCons) <- Type -> QName -> TCMT IO (Type, IsPathCons)
    checkConstructorType Type
    e QName
    d

            -- compute which constructor arguments are forced (only point constructors)
            forcedArgs <- if isPathCons == PointCons
                          then computeForcingAnnotations c t
                          else return []
            -- check that the sort (universe level) of the constructor type
            -- is contained in the sort of the data type
            -- (to avoid impredicative existential types)
            debugFitsIn s
            arity <- applyQuantityToJudgement ai $
              fitsIn IsData c uc forcedArgs t s
            -- this may have instantiated some metas in s, so we reduce
            s <- reduce s
            debugAdd c t

            (TelV fields _, boundary) <- telViewPathBoundary t

            -- We assume that the current context matches the parameters
            -- of the datatype in an empty context (c.f. getContextSize above).
            params <- getContextTelescope

            (con, comp, projNames) <- do
                -- Name for projection of ith field of constructor c is just c-i
                names <- forM [0 .. size fields - 1] $ \ Nat
    i ->
                  String -> TCMT IO QName
    freshAbstractQName'_ (String -> TCMT IO QName) -> String -> TCMT IO QName
    forall a b. (a -> b) -> a -> b
    $ Name -> String
    forall a. Pretty a => a -> String
    P.prettyShow (QName -> Name
    A.qnameName QName
    c) String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "-" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Nat -> String
    forall a. Show a => a -> String
    show Nat
    i

                -- nofIxs == 0 means the data type can be reconstructed
                -- by appling the QName d to the parameters.
                let dataT = Sort' Term -> Term -> Type
    forall t a. Sort' t -> a -> Type'' t a
    El Sort' Term
    s (Term -> Type) -> Term -> Type
    forall a b. (a -> b) -> a -> b
    $ QName -> [Elim' Term] -> Term
    Def QName
    d ([Elim' Term] -> Term) -> [Elim' Term] -> Term
    forall a b. (a -> b) -> a -> b
    $ (Arg Term -> Elim' Term) -> [Arg Term] -> [Elim' Term]
    forall a b. (a -> b) -> [a] -> [b]
    map Arg Term -> Elim' Term
    forall a. Arg a -> Elim' a
    Apply ([Arg Term] -> [Elim' Term]) -> [Arg Term] -> [Elim' Term]
    forall a b. (a -> b) -> a -> b
    $ Tele (Dom Type) -> [Arg Term]
    forall a t. DeBruijn a => Tele (Dom t) -> [Arg a]
    teleArgs Tele (Dom Type)
    params

                reportSDoc "tc.data.con.comp" 5 $ inTopContext $ vcat $
                  [ "params =" <+> pretty params
                  , "dataT  =" <+> pretty dataT
                  , "fields =" <+> pretty fields
                  , "names  =" <+> pretty names
                  ]

                let con = QName -> DataOrRecord -> Induction -> [Arg QName] -> ConHead
    ConHead QName
    c DataOrRecord
    forall p. DataOrRecord' p
    IsData Induction
    Inductive ([Arg QName] -> ConHead) -> [Arg QName] -> ConHead
    forall a b. (a -> b) -> a -> b
    $ (QName -> Arg (String, Type) -> Arg QName)
    -> [QName] -> [Arg (String, Type)] -> [Arg QName]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith QName -> Arg (String, Type) -> Arg QName
    forall a b. a -> Arg b -> Arg a
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    (<$) [QName]
    names ([Arg (String, Type)] -> [Arg QName])
    -> [Arg (String, Type)] -> [Arg QName]
    forall a b. (a -> b) -> a -> b
    $ (Dom' Term (String, Type) -> Arg (String, Type))
    -> [Dom' Term (String, Type)] -> [Arg (String, Type)]
    forall a b. (a -> b) -> [a] -> [b]
    map Dom' Term (String, Type) -> Arg (String, Type)
    forall t a. Dom' t a -> Arg a
    argFromDom ([Dom' Term (String, Type)] -> [Arg (String, Type)])
    -> [Dom' Term (String, Type)] -> [Arg (String, Type)]
    forall a b. (a -> b) -> a -> b
    $ Tele (Dom Type) -> [Dom' Term (String, Type)]
    forall t. Tele (Dom t) -> [Dom (String, t)]
    telToList Tele (Dom Type)
    fields

                defineProjections d con params names fields dataT
                -- Andreas, 2024-01-05 issue #7048:
                -- Only define hcomp when --cubical-compatible.
                cubicalCompatible <- cubicalCompatibleOption
                -- Cannot compose indexed inductive types yet.
                comp <- if cubicalCompatible && nofIxs == 0 && Info.defAbstract i == ConcreteDef
                        then inTopContext $ defineCompData d con params names fields dataT boundary
                        else return emptyCompKit
                return (con, comp, Just names)

            -- add parameters to constructor type and put into signature
            escapeContext impossible (size tel) $ do
              erasure <- optErasure <$> pragmaOptions
              addConstant' c ai (telePi tel t) $ Constructor
                  { conPars   = size tel
                  , conArity  = arity
                  , conSrcCon = con
                  , conData   = d
                  , conAbstr  = Info.defAbstract i
                  , conComp   = comp
                  , conProj   = projNames
                  , conForced = forcedArgs
                  , conErased = Nothing  -- computed during compilation to treeless
                  , conErasure = erasure
                  , conInline  = False
                  }

            -- Add the constructor to the instance table, if needed
            case Info.defInstance i of
              InstanceDef KwRange
    _r -> QName -> TCM () -> TCM ()
    forall (m :: * -> *) x a.
    (MonadTrace m, HasRange x) =>
    x -> m a -> m a
    setCurrentRange QName
    c (TCM () -> TCM ()) -> TCM () -> TCM ()
    forall a b. (a -> b) -> a -> b
    $ do
                -- Including the range of the @instance@ keyword, like
                -- @(getRange (r,c))@, does not produce good results.
                -- Andreas, 2020-01-28, issue #4360:
                -- Use addTypedInstance instead of addNamedInstance
                -- to detect unusable instances.
                QName -> Type -> TCM ()
    addTypedInstance QName
    c Type
    t
                -- addNamedInstance c d
              IsInstance
    NotInstanceDef -> () -> TCM ()
    forall a. a -> TCMT IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ()

            return isPathCons

      where
        -- Issue 3362: we need to do the `constructs` call inside the
        -- generalization, so unpack the A.Generalize
        checkConstructorType :: Type -> QName -> TCMT IO (Type, IsPathCons)
    checkConstructorType (A.ScopedExpr ScopeInfo
    s Type
    e) QName
    d = ScopeInfo
    -> TCMT IO (Type, IsPathCons) -> TCMT IO (Type, IsPathCons)
    forall (m :: * -> *) a. ReadTCState m => ScopeInfo -> m a -> m a
    withScope_ ScopeInfo
    s (TCMT IO (Type, IsPathCons) -> TCMT IO (Type, IsPathCons))
    -> TCMT IO (Type, IsPathCons) -> TCMT IO (Type, IsPathCons)
    forall a b. (a -> b) -> a -> b
    $ Type -> QName -> TCMT IO (Type, IsPathCons)
    checkConstructorType Type
    e QName
    d
        checkConstructorType Type
    e QName
    d = do
          let check :: Nat -> Type -> TCMT IO (Type, IsPathCons)
    check Nat
    k Type
    e = do
                t <- TCMT IO Type -> TCMT IO Type
    forall (m :: * -> *) a.
    (MonadTCEnv m, HasOptions m, MonadDebug m) =>
    m a -> m a
    workOnTypes (TCMT IO Type -> TCMT IO Type) -> TCMT IO Type -> TCMT IO Type
    forall a b. (a -> b) -> a -> b
    $ Type -> TCMT IO Type
    isType_ Type
    e
                -- check that the type of the constructor ends in the data type
                n <- getContextSize
                debugEndsIn t d (n - k)
                isPathCons <- constructs (n - k) k t d
                return (t, isPathCons)

          case Type
    e of
            A.Generalized Set1 QName
    s Type
    e -> do
              (_, t, isPathCons) <- Set QName
    -> TCMT IO (Type, IsPathCons)
    -> TCM ([Maybe QName], Type, IsPathCons)
    forall a.
    Set QName -> TCM (Type, a) -> TCM ([Maybe QName], Type, a)
    generalizeType' (Set1 QName -> Set QName
    forall a. NESet a -> Set a
    Set1.toSet Set1 QName
    s) (Nat -> Type -> TCMT IO (Type, IsPathCons)
    check Nat
    1 Type
    e)
              return (t, isPathCons)
            Type
    _ -> Nat -> Type -> TCMT IO (Type, IsPathCons)
    check Nat
    0 Type
    e

        debugEnter :: a -> a -> m ()
    debugEnter a
    c a
    e =
          String -> Nat -> TCMT IO Doc -> m ()
    forall (m :: * -> *).
    MonadDebug m =>
    String -> Nat -> TCMT IO Doc -> m ()
    reportSDoc String
    "tc.data.con" Nat
    5 (TCMT IO Doc -> m ()) -> TCMT IO Doc -> m ()
    forall a b. (a -> b) -> a -> b
    $ [TCMT IO Doc] -> TCMT IO Doc
    forall (m :: * -> *) (t :: * -> *).
    (Applicative m, Foldable t) =>
    t (m Doc) -> m Doc
    vcat
            [ TCMT IO Doc
    "checking constructor" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> a -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    forall (m :: * -> *). MonadPretty m => a -> m Doc
    prettyTCM a
    c TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> TCMT IO Doc
    ":" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> a -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    forall (m :: * -> *). MonadPretty m => a -> m Doc
    prettyTCM a
    e
            ]
        debugEndsIn :: a -> a -> a -> m ()
    debugEndsIn a
    t a
    d a
    n =
          String -> Nat -> TCMT IO Doc -> m ()
    forall (m :: * -> *).
    MonadDebug m =>
    String -> Nat -> TCMT IO Doc -> m ()
    reportSDoc String
    "tc.data.con" Nat
    15 (TCMT IO Doc -> m ()) -> TCMT IO Doc -> m ()
    forall a b. (a -> b) -> a -> b
    $ [TCMT IO Doc] -> TCMT IO Doc
    forall (m :: * -> *) (t :: * -> *).
    (Applicative m, Foldable t) =>
    t (m Doc) -> m Doc
    vcat
            [ [TCMT IO Doc] -> TCMT IO Doc
    forall (m :: * -> *) (t :: * -> *).
    (Applicative m, Foldable t) =>
    t (m Doc) -> m Doc
    sep [ TCMT IO Doc
    "checking that"
                  , Nat -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Functor m => Nat -> m Doc -> m Doc
    nest Nat
    2 (TCMT IO Doc -> TCMT IO Doc) -> TCMT IO Doc -> TCMT IO Doc
    forall a b. (a -> b) -> a -> b
    $ a -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    forall (m :: * -> *). MonadPretty m => a -> m Doc
    prettyTCM a
    t
                  , TCMT IO Doc
    "ends in" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> a -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    forall (m :: * -> *). MonadPretty m => a -> m Doc
    prettyTCM a
    d
                  ]
            , Nat -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Functor m => Nat -> m Doc -> m Doc
    nest Nat
    2 (TCMT IO Doc -> TCMT IO Doc) -> TCMT IO Doc -> TCMT IO Doc
    forall a b. (a -> b) -> a -> b
    $ TCMT IO Doc
    "nofPars =" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> String -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => String -> m Doc
    text (a -> String
    forall a. Show a => a -> String
    show a
    n)
            ]
        debugFitsIn :: a -> m ()
    debugFitsIn a
    s =
          String -> Nat -> TCMT IO Doc -> m ()
    forall (m :: * -> *).
    MonadDebug m =>
    String -> Nat -> TCMT IO Doc -> m ()
    reportSDoc String
    "tc.data.con" Nat
    15 (TCMT IO Doc -> m ()) -> TCMT IO Doc -> m ()
    forall a b. (a -> b) -> a -> b
    $ [TCMT IO Doc] -> TCMT IO Doc
    forall (m :: * -> *) (t :: * -> *).
    (Applicative m, Foldable t) =>
    t (m Doc) -> m Doc
    sep
            [ TCMT IO Doc
    "checking that the type fits in"
            , Nat -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Functor m => Nat -> m Doc -> m Doc
    nest Nat
    2 (TCMT IO Doc -> TCMT IO Doc) -> TCMT IO Doc -> TCMT IO Doc
    forall a b. (a -> b) -> a -> b
    $ a -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    forall (m :: * -> *). MonadPretty m => a -> m Doc
    prettyTCM a
    s
            ]
        debugAdd :: a -> a -> m ()
    debugAdd a
    c a
    t =
          String -> Nat -> TCMT IO Doc -> m ()
    forall (m :: * -> *).
    MonadDebug m =>
    String -> Nat -> TCMT IO Doc -> m ()
    reportSDoc String
    "tc.data.con" Nat
    5 (TCMT IO Doc -> m ()) -> TCMT IO Doc -> m ()
    forall a b. (a -> b) -> a -> b
    $ [TCMT IO Doc] -> TCMT IO Doc
    forall (m :: * -> *) (t :: * -> *).
    (Applicative m, Foldable t) =>
    t (m Doc) -> m Doc
    vcat
            [ TCMT IO Doc
    "adding constructor" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> a -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    forall (m :: * -> *). MonadPretty m => a -> m Doc
    prettyTCM a
    c TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> TCMT IO Doc
    ":" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> a -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    forall (m :: * -> *). MonadPretty m => a -> m Doc
    prettyTCM a
    t
            ]
    checkConstructor QName
    _ UniverseCheck
    _ Tele (Dom Type)
    _ Nat
    _ Sort' Term
    _ Constructor
    _ = TCM IsPathCons
    forall a. HasCallStack => a
    __IMPOSSIBLE__ -- constructors are axioms

    defineCompData ::
         QName         -- ^ Datatype name.
      -> ConHead       -- ^ Constructor.
      -> Telescope     -- ^ @Γ@ parameters.
      -> [QName]       -- ^ Projection names.
      -> Telescope     -- ^ @Γ ⊢ Φ@ field types.
      -> Type          -- ^ @Γ ⊢ T@ target type.
      -> Boundary      -- ^ @[(i,t_i,b_i)],  Γ.Φ ⊢ [ (i=0) -> t_i; (i=1) -> u_i ] : B_i@
      -> TCM CompKit
    defineCompData :: QName
    -> ConHead
    -> Tele (Dom Type)
    -> [QName]
    -> Tele (Dom Type)
    -> Type
    -> Boundary
    -> TCMT IO CompKit
    defineCompData QName
    d ConHead
    con Tele (Dom Type)
    params [QName]
    names Tele (Dom Type)
    fsT Type
    t Boundary
    boundary = do
      required <- (SomeBuiltin -> TCMT IO (Maybe Term))
    -> [SomeBuiltin] -> TCMT IO [Maybe Term]
    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 SomeBuiltin -> TCMT IO (Maybe Term)
    forall (m :: * -> *) a.
    (HasBuiltins m, IsBuiltin a) =>
    a -> m (Maybe Term)
    getTerm'
        [ BuiltinId -> SomeBuiltin
    forall a. IsBuiltin a => a -> SomeBuiltin
    someBuiltin BuiltinId
    builtinInterval
        , BuiltinId -> SomeBuiltin
    forall a. IsBuiltin a => a -> SomeBuiltin
    someBuiltin BuiltinId
    builtinIZero
        , BuiltinId -> SomeBuiltin
    forall a. IsBuiltin a => a -> SomeBuiltin
    someBuiltin BuiltinId
    builtinIOne
        , PrimitiveId -> SomeBuiltin
    forall a. IsBuiltin a => a -> SomeBuiltin
    someBuiltin PrimitiveId
    builtinIMin
        , PrimitiveId -> SomeBuiltin
    forall a. IsBuiltin a => a -> SomeBuiltin
    someBuiltin PrimitiveId
    builtinIMax
        , PrimitiveId -> SomeBuiltin
    forall a. IsBuiltin a => a -> SomeBuiltin
    someBuiltin PrimitiveId
    builtinINeg
        , PrimitiveId -> SomeBuiltin
    forall a. IsBuiltin a => a -> SomeBuiltin
    someBuiltin PrimitiveId
    builtinPOr
        , BuiltinId -> SomeBuiltin
    forall a. IsBuiltin a => a -> SomeBuiltin
    someBuiltin BuiltinId
    builtinItIsOne
        ]
      if not (all isJust required) then return $ emptyCompKit else do
        hcomp  <- whenDefined (null boundary) [builtinHComp,builtinTrans]
          (defineKanOperationD DoHComp  d con params names fsT t boundary)
        transp <- whenDefined True            [builtinTrans]
          (defineKanOperationD DoTransp d con params names fsT t boundary)
        return $ CompKit
          { nameOfTransp = transp
          , nameOfHComp  = hcomp
          }
      where
        -- Δ^I, i : I |- sub Δ : Δ
        sub :: a -> Substitution
    sub a
    tel = [ Nat -> Term
    var Nat
    n Term -> [Arg Term] -> Term
    forall t. Apply t => t -> [Arg Term] -> t
    `apply` [ArgInfo -> Term -> Arg Term
    forall e. ArgInfo -> e -> Arg e
    Arg ArgInfo
    defaultArgInfo (Term -> Arg Term) -> Term -> Arg Term
    forall a b. (a -> b) -> a -> b
    $ Nat -> Term
    var Nat
    0] | Nat
    n <- [Nat
    1..a -> Nat
    forall a. Sized a => a -> Nat
    size a
    tel] ] [Term] -> Substitution -> Substitution
    forall a. DeBruijn a => [a] -> Substitution' a -> Substitution' a
    ++# Impossible -> Substitution
    forall a. Impossible -> Substitution' a
    EmptyS Impossible
    forall a. HasCallStack => a
    __IMPOSSIBLE__
        withArgInfo :: Tele (Dom t) -> [b] -> [Arg b]
    withArgInfo Tele (Dom t)
    tel = (ArgInfo -> b -> Arg b) -> [ArgInfo] -> [b] -> [Arg b]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith ArgInfo -> b -> Arg b
    forall e. ArgInfo -> e -> Arg e
    Arg ((Dom' Term (String, t) -> ArgInfo)
    -> [Dom' Term (String, t)] -> [ArgInfo]
    forall a b. (a -> b) -> [a] -> [b]
    map Dom' Term (String, t) -> ArgInfo
    forall t e. Dom' t e -> ArgInfo
    domInfo ([Dom' Term (String, t)] -> [ArgInfo])
    -> (Tele (Dom t) -> [Dom' Term (String, t)])
    -> Tele (Dom t)
    -> [ArgInfo]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Tele (Dom t) -> [Dom' Term (String, t)]
    forall t. Tele (Dom t) -> [Dom (String, t)]
    telToList (Tele (Dom t) -> [ArgInfo]) -> Tele (Dom t) -> [ArgInfo]
    forall a b. (a -> b) -> a -> b
    $ Tele (Dom t)
    tel)

        defineKanOperationD :: Command
    -> QName
    -> ConHead
    -> Tele (Dom Type)
    -> [QName]
    -> Tele (Dom Type)
    -> Type
    -> Boundary
    -> TCMT IO (Maybe QName)
    defineKanOperationD Command
    cmd QName
    d ConHead
    con Tele (Dom Type)
    params [QName]
    names Tele (Dom Type)
    fsT Type
    t Boundary
    boundary = do
          let project :: Term -> QName -> Term
    project = (\ Term
    t QName
    p -> Term -> [Arg Term] -> Term
    forall t. Apply t => t -> [Arg Term] -> t
    apply (QName -> [Elim' Term] -> Term
    Def QName
    p []) [Term -> Arg Term
    forall e. e -> Arg e
    argN Term
    t])
          stuff <- Command
    -> Maybe Term
    -> (Term -> QName -> Term)
    -> QName
    -> Tele (Dom Type)
    -> Tele (Dom Type)
    -> [Arg QName]
    -> Type
    -> TCM
         (Maybe
            ((QName, Tele (Dom Type), Type, [Dom Type], [Term]), Substitution))
    defineKanOperationForFields Command
    cmd
                     (Bool -> Maybe ()
    forall b (m :: * -> *). (IsBool b, MonadPlus m) => b -> m ()
    guard (Bool -> Bool
    forall a. Boolean a => a -> a
    not (Bool -> Bool) -> Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $ Boundary -> Bool
    forall a. Null a => a -> Bool
    null Boundary
    boundary) Maybe () -> Maybe Term -> Maybe Term
    forall a b. Maybe a -> Maybe b -> Maybe b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Term -> Maybe Term
    forall a. a -> Maybe a
    Just (ConHead -> ConInfo -> [Elim' Term] -> Term
    Con ConHead
    con ConInfo
    ConOSystem ([Elim' Term] -> Term) -> [Elim' Term] -> Term
    forall a b. (a -> b) -> a -> b
    $ Tele (Dom Type) -> Boundary -> [Elim' Term]
    forall a.
    DeBruijn a =>
    Tele (Dom Type) -> Boundary' Nat a -> [Elim' a]
    teleElims Tele (Dom Type)
    fsT Boundary
    boundary))
                     Term -> QName -> Term
    project QName
    d Tele (Dom Type)
    params Tele (Dom Type)
    fsT ((QName -> Arg QName) -> [QName] -> [Arg QName]
    forall a b. (a -> b) -> [a] -> [b]
    map QName -> Arg QName
    forall e. e -> Arg e
    argN [QName]
    names) Type
    t
          caseMaybe stuff (return Nothing) $ \ ((QName
    theName, Tele (Dom Type)
    gamma , Type
    ty, [Dom Type]
    _cl_types , [Term]
    bodies), Substitution
    theSub) -> do

          iz <- TCMT IO Term
    forall (m :: * -> *).
    (HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
    m Term
    primIZero
          body <- do
            case cmd of
              Command
    DoHComp -> Term -> TCMT IO Term
    forall a. a -> TCMT IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Term -> TCMT IO Term) -> Term -> TCMT IO Term
    forall a b. (a -> b) -> a -> b
    $ ConHead -> ConInfo -> [Elim' Term] -> Term
    Con ConHead
    con ConInfo
    ConOSystem ((Arg Term -> Elim' Term) -> [Arg Term] -> [Elim' Term]
    forall a b. (a -> b) -> [a] -> [b]
    map Arg Term -> Elim' Term
    forall a. Arg a -> Elim' a
    Apply ([Arg Term] -> [Elim' Term]) -> [Arg Term] -> [Elim' Term]
    forall a b. (a -> b) -> a -> b
    $ Tele (Dom Type) -> [Term] -> [Arg Term]
    forall {t} {b}. Tele (Dom t) -> [b] -> [Arg b]
    withArgInfo Tele (Dom Type)
    fsT [Term]
    bodies)
              Command
    DoTransp | Boundary -> Bool
    forall a. Null a => a -> Bool
    null Boundary
    boundary {- && null ixs -} -> Term -> TCMT IO Term
    forall a. a -> TCMT IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Term -> TCMT IO Term) -> Term -> TCMT IO Term
    forall a b. (a -> b) -> a -> b
    $ ConHead -> ConInfo -> [Elim' Term] -> Term
    Con ConHead
    con ConInfo
    ConOSystem ((Arg Term -> Elim' Term) -> [Arg Term] -> [Elim' Term]
    forall a b. (a -> b) -> [a] -> [b]
    map Arg Term -> Elim' Term
    forall a. Arg a -> Elim' a
    Apply ([Arg Term] -> [Elim' Term]) -> [Arg Term] -> [Elim' Term]
    forall a b. (a -> b) -> a -> b
    $ Tele (Dom Type) -> [Term] -> [Arg Term]
    forall {t} {b}. Tele (Dom t) -> [b] -> [Arg b]
    withArgInfo Tele (Dom Type)
    fsT [Term]
    bodies)
                       | Bool
    otherwise -> do
                io <- TCMT IO Term
    forall (m :: * -> *).
    (HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
    m Term
    primIOne
                tIMax <- primIMax
                tIMin <- primIMin
                tINeg <- primINeg
                tPOr  <- fromMaybe __IMPOSSIBLE__ <$> getTerm' builtinPOr
                tHComp <- primHComp
                -- Δ = params
                -- Δ ⊢ Φ = fsT
                -- (δ : Δ) ⊢ T = R δ
                -- (δ : Δ) ⊢ con : Φ → R δ  -- no indexing
                -- boundary = [(i,t_i,u_i)]
                -- Δ.Φ ⊢ [ (i=0) -> t_i; (i=1) -> u_i ] : B_i
                -- Δ.Φ | PiPath Φ boundary (R δ) |- teleElims fsT boundary : R δ
                -- Γ = ((δ : Δ^I), φ, us : Φ[δ 0]) = gamma
                -- Γ ⊢ ty = R (δ i1)
                -- (γ : Γ) ⊢ cl_types = (flatten Φ)[n ↦ f_n (transpR γ)]
                -- Γ ⊢ bodies : Φ[δ i1]
                -- Γ ⊢ t : ty
                -- Γ, i : I ⊢ theSub : Δ.Φ
                let

                  -- Δ.Φ ⊢ u = Con con ConOSystem $ teleElims fsT boundary : R δ
                  u = ConHead -> ConInfo -> [Elim' Term] -> Term
    Con ConHead
    con ConInfo
    ConOSystem ([Elim' Term] -> Term) -> [Elim' Term] -> Term
    forall a b. (a -> b) -> a -> b
    $ Tele (Dom Type) -> Boundary -> [Elim' Term]
    forall a.
    DeBruijn a =>
    Tele (Dom Type) -> Boundary' Nat a -> [Elim' a]
    teleElims Tele (Dom Type)
    fsT Boundary
    boundary
                  -- Γ ⊢ u
                  the_u = Nat -> Substitution -> Substitution
    forall a. Nat -> Substitution' a -> Substitution' a
    liftS (Tele (Dom Type) -> Nat
    forall a. Sized a => a -> Nat
    size Tele (Dom Type)
    fsT) Substitution
    d0 Substitution' (SubstArg Term) -> Term -> Term
    forall a. Subst a => Substitution' (SubstArg a) -> a -> a
    `applySubst` Term
    u
                    where
                      -- δ : Δ^I, φ : F ⊢ [δ 0] : Δ
                      d0 :: Substitution
                      d0 :: Substitution
    d0 = Nat -> Substitution -> Substitution
    forall a. Nat -> Substitution' a -> Substitution' a
    wkS Nat
    1 -- Δ^I, φ : F ⊢ Δ
                                 (Term -> Substitution -> Substitution
    forall a. DeBruijn a => a -> Substitution' a -> Substitution' a
    consS Term
    iz Substitution
    forall a. Substitution' a
    IdS Substitution -> Substitution -> Substitution
    forall a.
    EndoSubst a =>
    Substitution' a -> Substitution' a -> Substitution' a
    `composeS` Tele (Dom Type) -> Substitution
    forall {a}. Sized a => a -> Substitution
    sub Tele (Dom Type)
    params) -- Δ^I ⊢ Δ
                                           -- Δ^I , i:I ⊢ sub params : Δ
                  the_phi = Nat -> Term -> Term
    forall a. Subst a => Nat -> a -> a
    raise (Tele (Dom Type) -> Nat
    forall a. Sized a => a -> Nat
    size Tele (Dom Type)
    fsT) (Term -> Term) -> Term -> Term
    forall a b. (a -> b) -> a -> b
    $ Nat -> Term
    var Nat
    0
                  -- Γ ⊢ sigma : Δ.Φ
                  -- sigma = [δ i1,bodies]
                  -- sigma = theSub[i1]
                  sigma = [Term] -> [Term]
    forall a. [a] -> [a]
    reverse [Term]
    bodies [Term] -> Substitution -> Substitution
    forall a. DeBruijn a => [a] -> Substitution' a -> Substitution' a
    ++# Substitution
    d1
                   where
                    -- δ i1
                    d1 :: Substitution
                    d1 :: Substitution
    d1 = Nat -> Substitution -> Substitution
    forall a. Nat -> Substitution' a -> Substitution' a
    wkS (Tele (Dom Type) -> Nat
    forall a. Sized a => a -> Nat
    size Tele (Dom Type)
    gamma Nat -> Nat -> Nat
    forall a. Num a => a -> a -> a
    - Tele (Dom Type) -> Nat
    forall a. Sized a => a -> Nat
    size Tele (Dom Type)
    params) -- Γ ⊢ Δ
                           (Term -> Substitution -> Substitution
    forall a. DeBruijn a => a -> Substitution' a -> Substitution' a
    consS Term
    io Substitution
    forall a. Substitution' a
    IdS Substitution -> Substitution -> Substitution
    forall a.
    EndoSubst a =>
    Substitution' a -> Substitution' a -> Substitution' a
    `composeS` Tele (Dom Type) -> Substitution
    forall {a}. Sized a => a -> Substitution
    sub Tele (Dom Type)
    params) -- Δ^I ⊢ Δ
                                     -- Δ^I , i:I ⊢ sub params : Δ

                  -- Δ.Φ ⊢ [ (i=0) -> t_i; (i=1) -> u_i ] : R δ
                  bs = Tele (Dom Type) -> Boundary -> Boundary
    fullBoundary Tele (Dom Type)
    fsT Boundary
    boundary
                  -- ψ = sigma `applySubst` map (\ i → i ∨ ~ i) . map fst $ boundary
                  -- Γ ⊢ t : R (δ i1)
                  w1' = ConHead -> ConInfo -> [Elim' Term] -> Term
    Con ConHead
    con ConInfo
    ConOSystem ([Elim' Term] -> Term) -> [Elim' Term] -> Term
    forall a b. (a -> b) -> a -> b
    $ Substitution
    Substitution' (SubstArg [Elim' Term])
    sigma Substitution' (SubstArg [Elim' Term])
    -> [Elim' Term] -> [Elim' Term]
    forall a. Subst a => Substitution' (SubstArg a) -> a -> a
    `applySubst` Tele (Dom Type) -> Boundary -> [Elim' Term]
    forall a.
    DeBruijn a =>
    Tele (Dom Type) -> Boundary' Nat a -> [Elim' a]
    teleElims Tele (Dom Type)
    fsT Boundary
    boundary
                  -- (δ, φ, u0) : Γ ⊢
                  -- w1 = hcomp (\ i → R (δ i1))
                  --            (\ i → [ ψ ↦ α (~ i), φ ↦ u0])
                  --            w1'
                  imax NamesT (TCMT IO) Term
    x NamesT (TCMT IO) Term
    y = Term -> NamesT (TCMT IO) Term
    forall a. a -> NamesT (TCMT IO) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Term
    tIMax NamesT (TCMT IO) Term
    -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <@> NamesT (TCMT IO) Term
    x NamesT (TCMT IO) Term
    -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <@> NamesT (TCMT IO) Term
    y
                  ineg NamesT (TCMT IO) Term
    r = Term -> NamesT (TCMT IO) Term
    forall a. a -> NamesT (TCMT IO) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Term
    tINeg NamesT (TCMT IO) Term
    -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <@> NamesT (TCMT IO) Term
    r
                  lvlOfType = (\ (Type Level
    l) -> Level -> Term
    Level Level
    l) (Sort' Term -> Term) -> (Type -> Sort' Term) -> Type -> Term
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Type -> Sort' Term
    forall a. LensSort a => a -> Sort' Term
    getSort
                  pOr NamesT (TCMT IO) Type
    la NamesT (TCMT IO) Term
    i NamesT (TCMT IO) Term
    j NamesT (TCMT IO) Term
    u0 NamesT (TCMT IO) Term
    u1 = Term -> NamesT (TCMT IO) Term
    forall a. a -> NamesT (TCMT IO) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Term
    tPOr NamesT (TCMT IO) Term
    -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <#> (Type -> Term
    lvlOfType (Type -> Term) -> NamesT (TCMT IO) Type -> NamesT (TCMT IO) Term
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> NamesT (TCMT IO) Type
    la) NamesT (TCMT IO) Term
    -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <@> NamesT (TCMT IO) Term
    i NamesT (TCMT IO) Term
    -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <@> NamesT (TCMT IO) Term
    j
                                               NamesT (TCMT IO) Term
    -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <#> String
    -> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
    -> NamesT (TCMT IO) Term
    forall (m :: * -> *).
    Monad m =>
    String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
    ilam String
    "o" (\ NamesT (TCMT IO) Term
    _ -> Type -> Term
    forall t a. Type'' t a -> a
    unEl (Type -> Term) -> NamesT (TCMT IO) Type -> NamesT (TCMT IO) Term
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> NamesT (TCMT IO) Type
    la) NamesT (TCMT IO) Term
    -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <@> NamesT (TCMT IO) Term
    u0 NamesT (TCMT IO) Term
    -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <@> NamesT (TCMT IO) Term
    u1
                  absAp m (Abs r)
    x m (SubstArg r)
    y = (Abs r -> SubstArg r -> r) -> m (Abs r) -> m (SubstArg r) -> m r
    forall (m :: * -> *) a1 a2 r.
    Monad m =>
    (a1 -> a2 -> r) -> m a1 -> m a2 -> m r
    liftM2 Abs r -> SubstArg r -> r
    forall a. Subst a => Abs a -> SubstArg a -> a
    absApp m (Abs r)
    x m (SubstArg r)
    y

                  mkFace (Term
    r,(Term
    u1,Term
    u2)) = Names
    -> NamesT (TCMT IO) (Abs (Term, Term))
    -> TCMT IO (Abs (Term, Term))
    forall (m :: * -> *) a. Names -> NamesT m a -> m a
    runNamesT [] (NamesT (TCMT IO) (Abs (Term, Term)) -> TCMT IO (Abs (Term, Term)))
    -> NamesT (TCMT IO) (Abs (Term, Term))
    -> TCMT IO (Abs (Term, Term))
    forall a b. (a -> b) -> a -> b
    $ do
                    -- Γ
                    phi <- Term -> NamesT (TCMT IO) (NamesT (TCMT IO) Term)
    forall (m :: * -> *) a.
    (Monad m, Subst a) =>
    a -> NamesT m (NamesT m a)
    open Term
    the_phi  -- (δ , φ , us) ⊢ φ
                    -- Γ ⊢ ty = Abs i. R (δ i)
                    ty <- open (Abs "i" $ (liftS 1 (raiseS (size gamma - size params)) `composeS` sub params) `applySubst` t)

                    bind "i" $ \ forall b. (Subst b, DeBruijn b) => NamesT (TCMT IO) b
    i -> do
                      -- Γ, i
                      r  <- Term -> NamesT (TCMT IO) (NamesT (TCMT IO) Term)
    forall (m :: * -> *) a.
    (Monad m, Subst a) =>
    a -> NamesT m (NamesT m a)
    open (Term -> NamesT (TCMT IO) (NamesT (TCMT IO) Term))
    -> (Term -> Term)
    -> Term
    -> NamesT (TCMT IO) (NamesT (TCMT IO) Term)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Substitution' (SubstArg Term) -> Term -> Term
    forall a. Subst a => Substitution' (SubstArg a) -> a -> a
    applySubst Substitution
    Substitution' (SubstArg Term)
    theSub (Term -> NamesT (TCMT IO) (NamesT (TCMT IO) Term))
    -> Term -> NamesT (TCMT IO) (NamesT (TCMT IO) Term)
    forall a b. (a -> b) -> a -> b
    $ Term
    r
                      u1 <- open . applySubst theSub $ u1
                      u2 <- open . applySubst theSub $ u2
                      psi <- imax r (ineg r)
                      let
                        -- Γ, i ⊢ squeeze u = primTrans (\ j -> ty [i := i ∨ j]) (φ ∨ i) u
                        squeeze NamesT (TCMT IO) Term
    u = TCMT IO Term -> NamesT (TCMT IO) Term
    forall (m :: * -> *) a. Monad m => m a -> NamesT m a
    cl TCMT IO Term
    forall (m :: * -> *).
    (HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
    m Term
    primTrans
                                              NamesT (TCMT IO) Term
    -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <#> String
    -> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
    -> NamesT (TCMT IO) Term
    forall (m :: * -> *).
    Monad m =>
    String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
    lam String
    "j" (\ NamesT (TCMT IO) Term
    j -> Type -> Term
    lvlOfType (Type -> Term) -> NamesT (TCMT IO) Type -> NamesT (TCMT IO) Term
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> NamesT (TCMT IO) (Abs Type)
    ty NamesT (TCMT IO) (Abs Type)
    -> NamesT (TCMT IO) (SubstArg Type) -> NamesT (TCMT IO) Type
    forall {m :: * -> *} {r}.
    (Monad m, Subst r) =>
    m (Abs r) -> m (SubstArg r) -> m r
    `absAp` (NamesT (TCMT IO) Term
    -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
    imax NamesT (TCMT IO) Term
    forall b. (Subst b, DeBruijn b) => NamesT (TCMT IO) b
    i NamesT (TCMT IO) Term
    j))
                                              NamesT (TCMT IO) Term
    -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <@> String
    -> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
    -> NamesT (TCMT IO) Term
    forall (m :: * -> *).
    Monad m =>
    String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
    lam String
    "j" (\ NamesT (TCMT IO) Term
    j -> Type -> Term
    forall t a. Type'' t a -> a
    unEl (Type -> Term) -> NamesT (TCMT IO) Type -> NamesT (TCMT IO) Term
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> NamesT (TCMT IO) (Abs Type)
    ty NamesT (TCMT IO) (Abs Type)
    -> NamesT (TCMT IO) (SubstArg Type) -> NamesT (TCMT IO) Type
    forall {m :: * -> *} {r}.
    (Monad m, Subst r) =>
    m (Abs r) -> m (SubstArg r) -> m r
    `absAp` (NamesT (TCMT IO) Term
    -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
    imax NamesT (TCMT IO) Term
    forall b. (Subst b, DeBruijn b) => NamesT (TCMT IO) b
    i NamesT (TCMT IO) Term
    j))
                                              NamesT (TCMT IO) Term
    -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <@> (NamesT (TCMT IO) Term
    phi NamesT (TCMT IO) Term
    -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
    `imax` NamesT (TCMT IO) Term
    forall b. (Subst b, DeBruijn b) => NamesT (TCMT IO) b
    i)
                                              NamesT (TCMT IO) Term
    -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <@> NamesT (TCMT IO) Term
    u
                      alpha <- pOr (ty `absAp` i)
                                  (ineg r)
                                  r
                               (ilam "o" $ \ NamesT (TCMT IO) Term
    _ -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
    squeeze NamesT (TCMT IO) Term
    u1) (ilam "o" $ \ NamesT (TCMT IO) Term
    _ -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
    squeeze NamesT (TCMT IO) Term
    u2)
                      return $ (psi, alpha)

                -- Γ ⊢ Abs i. [(ψ_n,α_n : [ψ] → R (δ i))]
                faces <- mapM mkFace $ theBoundary $ tmBoundary bs

                runNamesT [] $ do
                    -- Γ
                    w1' <- open w1'
                    phi <- open the_phi
                    u   <- open the_u
                    -- R (δ i1)
                    ty <- open ty
                    faces <- mapM (\ Abs (Term, Term)
    x -> (NamesT (TCMT IO) Term
     -> NamesT (TCMT IO) (Abs Term)
     -> (NamesT (TCMT IO) Term, NamesT (TCMT IO) (Abs Term)))
    -> NamesT (TCMT IO) (NamesT (TCMT IO) Term)
    -> NamesT (TCMT IO) (NamesT (TCMT IO) (Abs Term))
    -> NamesT
         (TCMT IO) (NamesT (TCMT IO) Term, NamesT (TCMT IO) (Abs Term))
    forall (m :: * -> *) a1 a2 r.
    Monad m =>
    (a1 -> a2 -> r) -> m a1 -> m a2 -> m r
    liftM2 (,) (Term -> NamesT (TCMT IO) (NamesT (TCMT IO) Term)
    forall (m :: * -> *) a.
    (Monad m, Subst a) =>
    a -> NamesT m (NamesT m a)
    open (Term -> NamesT (TCMT IO) (NamesT (TCMT IO) Term))
    -> (Abs Term -> Term)
    -> Abs Term
    -> NamesT (TCMT IO) (NamesT (TCMT IO) Term)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Impossible -> Abs Term -> Term
    forall a. Subst a => Impossible -> Abs a -> a
    noabsApp Impossible
    forall a. HasCallStack => a
    __IMPOSSIBLE__ (Abs Term -> NamesT (TCMT IO) (NamesT (TCMT IO) Term))
    -> Abs Term -> NamesT (TCMT IO) (NamesT (TCMT IO) Term)
    forall a b. (a -> b) -> a -> b
    $ ((Term, Term) -> Term) -> Abs (Term, Term) -> Abs Term
    forall a b. (a -> b) -> Abs a -> Abs b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (Term, Term) -> Term
    forall a b. (a, b) -> a
    fst Abs (Term, Term)
    x) (Abs Term -> NamesT (TCMT IO) (NamesT (TCMT IO) (Abs Term))
    forall (m :: * -> *) a.
    (Monad m, Subst a) =>
    a -> NamesT m (NamesT m a)
    open (Abs Term -> NamesT (TCMT IO) (NamesT (TCMT IO) (Abs Term)))
    -> Abs Term -> NamesT (TCMT IO) (NamesT (TCMT IO) (Abs Term))
    forall a b. (a -> b) -> a -> b
    $ ((Term, Term) -> Term) -> Abs (Term, Term) -> Abs Term
    forall a b. (a -> b) -> Abs a -> Abs b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (Term, Term) -> Term
    forall a b. (a, b) -> b
    snd Abs (Term, Term)
    x)) faces
                    let
                      thePsi = (NamesT (TCMT IO) Term
     -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
    -> [NamesT (TCMT IO) Term] -> NamesT (TCMT IO) Term
    forall a. (a -> a -> a) -> [a] -> a
    forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
    foldl1 NamesT (TCMT IO) Term
    -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
    imax (((NamesT (TCMT IO) Term, NamesT (TCMT IO) (Abs Term))
     -> NamesT (TCMT IO) Term)
    -> [(NamesT (TCMT IO) Term, NamesT (TCMT IO) (Abs Term))]
    -> [NamesT (TCMT IO) Term]
    forall a b. (a -> b) -> [a] -> [b]
    map (NamesT (TCMT IO) Term, NamesT (TCMT IO) (Abs Term))
    -> NamesT (TCMT IO) Term
    forall a b. (a, b) -> a
    fst [(NamesT (TCMT IO) Term, NamesT (TCMT IO) (Abs Term))]
    faces)
                      hcomp NamesT (TCMT IO) Type
    ty NamesT (TCMT IO) Term
    phi NamesT (TCMT IO) Term
    sys NamesT (TCMT IO) Term
    a0 = Term -> NamesT (TCMT IO) Term
    forall a. a -> NamesT (TCMT IO) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Term
    tHComp NamesT (TCMT IO) Term
    -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <#> (Type -> Term
    lvlOfType (Type -> Term) -> NamesT (TCMT IO) Type -> NamesT (TCMT IO) Term
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> NamesT (TCMT IO) Type
    ty)
                                                        NamesT (TCMT IO) Term
    -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <#> (Type -> Term
    forall t a. Type'' t a -> a
    unEl (Type -> Term) -> NamesT (TCMT IO) Type -> NamesT (TCMT IO) Term
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> NamesT (TCMT IO) Type
    ty)
                                                        NamesT (TCMT IO) Term
    -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <#> NamesT (TCMT IO) Term
    phi
                                                        NamesT (TCMT IO) Term
    -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <@> NamesT (TCMT IO) Term
    sys
                                                        NamesT (TCMT IO) Term
    -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <@> NamesT (TCMT IO) Term
    a0
                    let
                     sys = String
    -> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
    -> NamesT (TCMT IO) Term
    forall (m :: * -> *).
    Monad m =>
    String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
    lam String
    "i" ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
     -> NamesT (TCMT IO) Term)
    -> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
    -> NamesT (TCMT IO) Term
    forall a b. (a -> b) -> a -> b
    $ \ NamesT (TCMT IO) Term
    i -> do
                      let
                        recurse :: [(NamesT (TCMT IO) Term, NamesT (TCMT IO) (Abs Term))]
    -> NamesT (TCMT IO) Term
    recurse [(NamesT (TCMT IO) Term
    psi,NamesT (TCMT IO) (Abs Term)
    alpha)] = NamesT (TCMT IO) (Abs Term)
    alpha NamesT (TCMT IO) (Abs Term)
    -> NamesT (TCMT IO) (SubstArg Term) -> NamesT (TCMT IO) Term
    forall {m :: * -> *} {r}.
    (Monad m, Subst r) =>
    m (Abs r) -> m (SubstArg r) -> m r
    `absAp` (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
    ineg NamesT (TCMT IO) Term
    i)
                        recurse ((NamesT (TCMT IO) Term
    psi,NamesT (TCMT IO) (Abs Term)
    alpha):[(NamesT (TCMT IO) Term, NamesT (TCMT IO) (Abs Term))]
    xs) = NamesT (TCMT IO) Type
    -> NamesT (TCMT IO) Term
    -> NamesT (TCMT IO) Term
    -> NamesT (TCMT IO) Term
    -> NamesT (TCMT IO) Term
    -> NamesT (TCMT IO) Term
    pOr NamesT (TCMT IO) Type
    ty
                                                       NamesT (TCMT IO) Term
    psi  NamesT (TCMT IO) Term
    theOr
                                                       (NamesT (TCMT IO) (Abs Term)
    alpha NamesT (TCMT IO) (Abs Term)
    -> NamesT (TCMT IO) (SubstArg Term) -> NamesT (TCMT IO) Term
    forall {m :: * -> *} {r}.
    (Monad m, Subst r) =>
    m (Abs r) -> m (SubstArg r) -> m r
    `absAp` (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
    ineg NamesT (TCMT IO) Term
    i)) ([(NamesT (TCMT IO) Term, NamesT (TCMT IO) (Abs Term))]
    -> NamesT (TCMT IO) Term
    recurse [(NamesT (TCMT IO) Term, NamesT (TCMT IO) (Abs Term))]
    xs)
                          where
                            theOr :: NamesT (TCMT IO) Term
    theOr = (NamesT (TCMT IO) Term
     -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
    -> [NamesT (TCMT IO) Term] -> NamesT (TCMT IO) Term
    forall a. (a -> a -> a) -> [a] -> a
    forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
    foldl1 NamesT (TCMT IO) Term
    -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
    imax (((NamesT (TCMT IO) Term, NamesT (TCMT IO) (Abs Term))
     -> NamesT (TCMT IO) Term)
    -> [(NamesT (TCMT IO) Term, NamesT (TCMT IO) (Abs Term))]
    -> [NamesT (TCMT IO) Term]
    forall a b. (a -> b) -> [a] -> [b]
    map (NamesT (TCMT IO) Term, NamesT (TCMT IO) (Abs Term))
    -> NamesT (TCMT IO) Term
    forall a b. (a, b) -> a
    fst [(NamesT (TCMT IO) Term, NamesT (TCMT IO) (Abs Term))]
    xs)
                        recurse [] = NamesT (TCMT IO) Term
    forall a. HasCallStack => a
    __IMPOSSIBLE__
                        sys_alpha :: NamesT (TCMT IO) Term
    sys_alpha = [(NamesT (TCMT IO) Term, NamesT (TCMT IO) (Abs Term))]
    -> NamesT (TCMT IO) Term
    recurse [(NamesT (TCMT IO) Term, NamesT (TCMT IO) (Abs Term))]
    faces
                      NamesT (TCMT IO) Type
    -> NamesT (TCMT IO) Term
    -> NamesT (TCMT IO) Term
    -> NamesT (TCMT IO) Term
    -> NamesT (TCMT IO) Term
    -> NamesT (TCMT IO) Term
    pOr NamesT (TCMT IO) Type
    ty
                                                       NamesT (TCMT IO) Term
    thePsi    NamesT (TCMT IO) Term
    phi
                                                       NamesT (TCMT IO) Term
    sys_alpha (String
    -> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
    -> NamesT (TCMT IO) Term
    forall (m :: * -> *).
    Monad m =>
    String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
    ilam String
    "o" ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
     -> NamesT (TCMT IO) Term)
    -> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
    -> NamesT (TCMT IO) Term
    forall a b. (a -> b) -> a -> b
    $ \ NamesT (TCMT IO) Term
    _ -> NamesT (TCMT IO) Term
    u)
                    hcomp ty (thePsi `imax` phi) sys w1'

          let

            -- δ : Δ^I, φ : F ⊢ [δ 0] : Δ
            d0 :: Substitution
            d0 = Nat -> Substitution -> Substitution
    forall a. Nat -> Substitution' a -> Substitution' a
    wkS Nat
    1 -- Δ^I, φ : F ⊢ Δ
                           (Term -> Substitution -> Substitution
    forall a. DeBruijn a => a -> Substitution' a -> Substitution' a
    consS Term
    iz Substitution
    forall a. Substitution' a
    IdS Substitution -> Substitution -> Substitution
    forall a.
    EndoSubst a =>
    Substitution' a -> Substitution' a -> Substitution' a
    `composeS` Tele (Dom Type) -> Substitution
    forall {a}. Sized a => a -> Substitution
    sub Tele (Dom Type)
    params) -- Δ^I ⊢ Δ
                                     -- Δ^I , i:I ⊢ sub params : Δ

            -- Δ.Φ ⊢ u = Con con ConOSystem $ teleElims fsT boundary : R δ
    --        u = Con con ConOSystem $ teleElims fsT boundary
            up = ConHead
    -> ConPatternInfo
    -> [Arg (Named_ (Pattern' DBPatVar))]
    -> Pattern' DBPatVar
    forall x.
    ConHead -> ConPatternInfo -> [NamedArg (Pattern' x)] -> Pattern' x
    ConP ConHead
    con (PatternInfo
    -> Bool -> Bool -> Maybe (Arg Type) -> Bool -> ConPatternInfo
    ConPatternInfo PatternInfo
    defaultPatternInfo Bool
    False Bool
    False Maybe (Arg Type)
    forall a. Maybe a
    Nothing Bool
    False) ([Arg (Named_ (Pattern' DBPatVar))] -> Pattern' DBPatVar)
    -> [Arg (Named_ (Pattern' DBPatVar))] -> Pattern' DBPatVar
    forall a b. (a -> b) -> a -> b
    $
                   Tele (Dom Type) -> Boundary -> [Arg (Named_ (Pattern' DBPatVar))]
    forall a.
    DeBruijn a =>
    Tele (Dom Type) -> Boundary -> [NamedArg (Pattern' a)]
    telePatterns (Substitution
    Substitution' (SubstArg (Tele (Dom Type)))
    d0 Substitution' (SubstArg (Tele (Dom Type)))
    -> Tele (Dom Type) -> Tele (Dom Type)
    forall a. Subst a => Substitution' (SubstArg a) -> a -> a
    `applySubst` Tele (Dom Type)
    fsT) (Nat -> Substitution -> Substitution
    forall a. Nat -> Substitution' a -> Substitution' a
    liftS (Tele (Dom Type) -> Nat
    forall a. Sized a => a -> Nat
    size Tele (Dom Type)
    fsT) Substitution
    d0 Substitution' (SubstArg Boundary) -> Boundary -> Boundary
    forall a. Subst a => Substitution' (SubstArg a) -> a -> a
    `applySubst` Boundary
    boundary)
    --        gamma' = telFromList $ take (size gamma - 1) $ telToList gamma

            -- (δ , φ , fs : Φ[d0]) ⊢ u[liftS Φ d0]
            -- (δ , φ, u) : Γ ⊢ body
            -- Δ ⊢ Φ = fsT
            -- (δ , φ , fs : Φ[d0]) ⊢ u[liftS Φ d0] `consS` raiseS Φ : Γ
    --        (tel',theta) = (abstract gamma' (d0 `applySubst` fsT), (liftS (size fsT) d0 `applySubst` u) `consS` raiseS (size fsT))

          let
            pats | Boundary -> Bool
    forall a. Null a => a -> Bool
    null Boundary
    boundary = Tele (Dom Type) -> [Arg (Named_ (Pattern' DBPatVar))]
    forall a t. DeBruijn a => Tele (Dom t) -> [NamedArg a]
    teleNamedArgs Tele (Dom Type)
    gamma
                 | Bool
    otherwise     = Nat
    -> [Arg (Named_ (Pattern' DBPatVar))]
    -> [Arg (Named_ (Pattern' DBPatVar))]
    forall a. Nat -> [a] -> [a]
    take (Tele (Dom Type) -> Nat
    forall a. Sized a => a -> Nat
    size Tele (Dom Type)
    gamma Nat -> Nat -> Nat
    forall a. Num a => a -> a -> a
    - Tele (Dom Type) -> Nat
    forall a. Sized a => a -> Nat
    size Tele (Dom Type)
    fsT) (Tele (Dom Type) -> [Arg (Named_ (Pattern' DBPatVar))]
    forall a t. DeBruijn a => Tele (Dom t) -> [NamedArg a]
    teleNamedArgs Tele (Dom Type)
    gamma) [Arg (Named_ (Pattern' DBPatVar))]
    -> [Arg (Named_ (Pattern' DBPatVar))]
    -> [Arg (Named_ (Pattern' DBPatVar))]
    forall a. [a] -> [a] -> [a]
    ++ [Named_ (Pattern' DBPatVar) -> Arg (Named_ (Pattern' DBPatVar))
    forall e. e -> Arg e
    argN (Named_ (Pattern' DBPatVar) -> Arg (Named_ (Pattern' DBPatVar)))
    -> Named_ (Pattern' DBPatVar) -> Arg (Named_ (Pattern' DBPatVar))
    forall a b. (a -> b) -> a -> b
    $ Pattern' DBPatVar -> Named_ (Pattern' DBPatVar)
    forall a name. a -> Named name a
    unnamed (Pattern' DBPatVar -> Named_ (Pattern' DBPatVar))
    -> Pattern' DBPatVar -> Named_ (Pattern' DBPatVar)
    forall a b. (a -> b) -> a -> b
    $ Pattern' DBPatVar
    up]
            clause = Clause
              { clauseTel :: Tele (Dom Type)
    clauseTel         = Tele (Dom Type)
    gamma
              , clauseType :: Maybe (Arg Type)
    clauseType        = Arg Type -> Maybe (Arg Type)
    forall a. a -> Maybe a
    Just (Arg Type -> Maybe (Arg Type))
    -> (Type -> Arg Type) -> Type -> Maybe (Arg Type)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Type -> Arg Type
    forall e. e -> Arg e
    argN (Type -> Maybe (Arg Type)) -> Type -> Maybe (Arg Type)
    forall a b. (a -> b) -> a -> b
    $ Type
    ty
              , namedClausePats :: [Arg (Named_ (Pattern' DBPatVar))]
    namedClausePats   = [Arg (Named_ (Pattern' DBPatVar))]
    pats
              , clauseFullRange :: Range
    clauseFullRange   = Range
    forall a. Range' a
    noRange
              , clauseLHSRange :: Range
    clauseLHSRange    = Range
    forall a. Range' a
    noRange
              , clauseCatchall :: Catchall
    clauseCatchall    = Catchall
    forall a. Null a => a
    empty
              , clauseBody :: Maybe Term
    clauseBody        = Term -> Maybe Term
    forall a. a -> Maybe a
    Just (Term -> Maybe Term) -> Term -> Maybe Term
    forall a b. (a -> b) -> a -> b
    $ Term
    body
              , clauseRecursive :: Maybe Bool
    clauseRecursive   = Maybe Bool
    forall a. Maybe a
    Nothing
                  -- Andreas 2020-02-06 TODO
                  -- Or: Just False;  is it known to be non-recursive?
              , clauseUnreachable :: Maybe Bool
    clauseUnreachable = Bool -> Maybe Bool
    forall a. a -> Maybe a
    Just Bool
    False
              , clauseEllipsis :: ExpandedEllipsis
    clauseEllipsis    = ExpandedEllipsis
    NoEllipsis
              , clauseWhereModule :: Maybe ModuleName
    clauseWhereModule = Maybe ModuleName
    forall a. Maybe a
    Nothing
              }
            cs = [Clause
    clause]
          addClauses theName cs
          (mst, _, cc) <- inTopContext (compileClauses Nothing cs)
          whenJust mst $ setSplitTree theName
          setCompiledClauses theName cc
          setTerminates theName True
          return $ Just theName

        whenDefined :: Bool -> t a -> m (Maybe a) -> m (Maybe a)
    whenDefined Bool
    False t a
    _ m (Maybe a)
    _ = Maybe a -> m (Maybe a)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe a
    forall a. Maybe a
    Nothing
        whenDefined Bool
    True t a
    xs m (Maybe a)
    m = do
          xs <- (a -> m (Maybe Term)) -> t a -> m (t (Maybe Term))
    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) -> t a -> m (t b)
    mapM a -> m (Maybe Term)
    forall (m :: * -> *) a.
    (HasBuiltins m, IsBuiltin a) =>
    a -> m (Maybe Term)
    getTerm' t a
    xs
          if all isJust xs then m else return Nothing

    -- Andrea: TODO handle Irrelevant fields somehow.
    -- | Define projections for non-indexed data types (families don't work yet).
    --   Of course, these projections are partial functions in general.
    --
    --   Precondition: we are in the context Γ of the data type parameters.
    defineProjections :: QName      -- datatype name
                      -> ConHead
                      -> Telescope  -- Γ parameters
                      -> [QName]    -- projection names
                      -> Telescope  -- Γ ⊢ Φ field types
                      -> Type       -- Γ ⊢ T target type
                      -> TCM ()
    defineProjections :: QName
    -> ConHead
    -> Tele (Dom Type)
    -> [QName]
    -> Tele (Dom Type)
    -> Type
    -> TCM ()
    defineProjections QName
    dataName ConHead
    con Tele (Dom Type)
    params [QName]
    names Tele (Dom Type)
    fsT Type
    t = do
      let
        -- Γ , (d : T) ⊢ Φ[n ↦ proj n d]
        fieldTypes :: [Dom Type]
    fieldTypes = ([ QName -> [Elim' Term] -> Term
    Def QName
    f [] Term -> [Arg Term] -> Term
    forall t. Apply t => t -> [Arg Term] -> t
    `apply` [Term -> Arg Term
    forall e. e -> Arg e
    argN (Term -> Arg Term) -> Term -> Arg Term
    forall a b. (a -> b) -> a -> b
    $ Nat -> Term
    var Nat
    0] | QName
    f <- [QName] -> [QName]
    forall a. [a] -> [a]
    reverse [QName]
    names ] [Term] -> Substitution -> Substitution
    forall a. DeBruijn a => [a] -> Substitution' a -> Substitution' a
    ++# Nat -> Substitution
    forall a. Nat -> Substitution' a
    raiseS Nat
    1) Substitution' (SubstArg [Dom Type]) -> [Dom Type] -> [Dom Type]
    forall a. Subst a => Substitution' (SubstArg a) -> a -> a
    `applySubst`
                        Tele (Dom Type) -> [Dom Type]
    forall a. TermSubst a => Tele (Dom a) -> [Dom a]
    flattenTel Tele (Dom Type)
    fsT  -- Γ , Φ ⊢ Φ
        -- ⊢ Γ , (d : T)
        projTel :: Tele (Dom Type)
    projTel    = Tele (Dom Type) -> Tele (Dom Type) -> Tele (Dom Type)
    forall t. Abstract t => Tele (Dom Type) -> t -> t
    abstract Tele (Dom Type)
    params (Dom Type -> Abs (Tele (Dom Type)) -> Tele (Dom Type)
    forall a. a -> Abs (Tele a) -> Tele a
    ExtendTel (Type -> Dom Type
    forall a. a -> Dom a
    defaultDom Type
    t) (String -> Tele (Dom Type) -> Abs (Tele (Dom Type))
    forall a. String -> a -> Abs a
    Abs String
    "d" Tele (Dom Type)
    forall a. Tele a
    EmptyTel))
        np :: Nat
    np         = Tele (Dom Type) -> Nat
    forall a. Sized a => a -> Nat
    size Tele (Dom Type)
    params

      [(Nat, QName, Dom Type)]
    -> ((Nat, QName, Dom Type) -> TCM ()) -> TCM ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    t a -> (a -> m b) -> m ()
    forM_ ([Nat] -> [QName] -> [Dom Type] -> [(Nat, QName, Dom Type)]
    forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
    zip3 (Nat -> [Nat]
    forall a. Integral a => a -> [a]
    downFrom ([Dom Type] -> Nat
    forall a. Sized a => a -> Nat
    size [Dom Type]
    fieldTypes)) [QName]
    names [Dom Type]
    fieldTypes) (((Nat, QName, Dom Type) -> TCM ()) -> TCM ())
    -> ((Nat, QName, Dom Type) -> TCM ()) -> TCM ()
    forall a b. (a -> b) -> a -> b
    $ \ (Nat
    i,QName
    projName,Dom Type
    ty) -> do
        let
          projType :: Dom Type
    projType = Tele (Dom Type) -> Type -> Type
    forall t. Abstract t => Tele (Dom Type) -> t -> t
    abstract Tele (Dom Type)
    projTel (Type -> Type) -> Dom Type -> Dom Type
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Dom Type
    ty
          cpi :: ConPatternInfo
    cpi    = PatternInfo
    -> Bool -> Bool -> Maybe (Arg Type) -> Bool -> ConPatternInfo
    ConPatternInfo PatternInfo
    defaultPatternInfo Bool
    False Bool
    False (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
    $ Type -> Arg Type
    forall e. e -> Arg e
    argN (Type -> Arg Type) -> Type -> Arg Type
    forall a b. (a -> b) -> a -> b
    $ Nat -> Type -> Type
    forall a. Subst a => Nat -> a -> a
    raise (Tele (Dom Type) -> Nat
    forall a. Sized a => a -> Nat
    size Tele (Dom Type)
    fsT) Type
    t) Bool
    False
          conp :: Arg (Named_ (Pattern' DBPatVar))
    conp   = Pattern' DBPatVar -> Arg (Named_ (Pattern' DBPatVar))
    forall a. a -> NamedArg a
    defaultNamedArg (Pattern' DBPatVar -> Arg (Named_ (Pattern' DBPatVar)))
    -> Pattern' DBPatVar -> Arg (Named_ (Pattern' DBPatVar))
    forall a b. (a -> b) -> a -> b
    $ ConHead
    -> ConPatternInfo
    -> [Arg (Named_ (Pattern' DBPatVar))]
    -> Pattern' DBPatVar
    forall x.
    ConHead -> ConPatternInfo -> [NamedArg (Pattern' x)] -> Pattern' x
    ConP ConHead
    con ConPatternInfo
    cpi ([Arg (Named_ (Pattern' DBPatVar))] -> Pattern' DBPatVar)
    -> [Arg (Named_ (Pattern' DBPatVar))] -> Pattern' DBPatVar
    forall a b. (a -> b) -> a -> b
    $ Tele (Dom Type) -> [Arg (Named_ (Pattern' DBPatVar))]
    forall a t. DeBruijn a => Tele (Dom t) -> [NamedArg a]
    teleNamedArgs Tele (Dom Type)
    fsT
          sigma :: Substitution
    sigma  = ConHead -> ConInfo -> [Elim' Term] -> Term
    Con ConHead
    con ConInfo
    ConOSystem ((Arg Term -> Elim' Term) -> [Arg Term] -> [Elim' Term]
    forall a b. (a -> b) -> [a] -> [b]
    map Arg Term -> Elim' Term
    forall a. Arg a -> Elim' a
    Apply ([Arg Term] -> [Elim' Term]) -> [Arg Term] -> [Elim' Term]
    forall a b. (a -> b) -> a -> b
    $ Tele (Dom Type) -> [Arg Term]
    forall a t. DeBruijn a => Tele (Dom t) -> [Arg a]
    teleArgs Tele (Dom Type)
    fsT) Term -> Substitution -> Substitution
    forall a. DeBruijn a => a -> Substitution' a -> Substitution' a
    `consS` Nat -> Substitution
    forall a. Nat -> Substitution' a
    raiseS (Tele (Dom Type) -> Nat
    forall a. Sized a => a -> Nat
    size Tele (Dom Type)
    fsT)
          clause :: Clause
    clause = Clause
    forall a. Null a => a
    empty
              { clauseTel         = abstract params fsT
              , namedClausePats   = [ conp ]
              , clauseBody        = Just $ var i
              , clauseType        = Just $ argN $ applySubst sigma $ unDom ty
              , clauseRecursive   = Just False  -- non-recursive
              , clauseUnreachable = Just False
              }

        String -> Nat -> TCMT IO Doc -> TCM ()
    forall (m :: * -> *).
    MonadDebug m =>
    String -> Nat -> TCMT IO Doc -> m ()
    reportSDoc String
    "tc.data.proj" Nat
    20 (TCMT IO Doc -> TCM ()) -> TCMT IO Doc -> TCM ()
    forall a b. (a -> b) -> a -> b
    $ TCMT IO Doc -> TCMT IO Doc
    forall (tcm :: * -> *) a.
    (MonadTCEnv tcm, ReadTCState tcm) =>
    tcm a -> tcm a
    inTopContext (TCMT IO Doc -> TCMT IO Doc) -> TCMT IO Doc -> TCMT IO Doc
    forall a b. (a -> b) -> a -> b
    $ [TCMT IO Doc] -> TCMT IO Doc
    forall (m :: * -> *) (t :: * -> *).
    (Applicative m, Foldable t) =>
    t (m Doc) -> m Doc
    sep
          [ TCMT IO Doc
    "proj" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> (Nat, Dom Type) -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    forall (m :: * -> *). MonadPretty m => (Nat, Dom Type) -> m Doc
    prettyTCM (Nat
    i,Dom Type
    ty)
          , Nat -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Functor m => Nat -> m Doc -> m Doc
    nest Nat
    2 (TCMT IO Doc -> TCMT IO Doc) -> TCMT IO Doc -> TCMT IO Doc
    forall a b. (a -> b) -> a -> b
    $ [TCMT IO Doc] -> TCMT IO Doc
    forall (m :: * -> *) (t :: * -> *).
    (Applicative m, Foldable t) =>
    t (m Doc) -> m Doc
    sep [ QName -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    forall (m :: * -> *). MonadPretty m => QName -> m Doc
    prettyTCM QName
    projName, TCMT IO 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
    projType ]
          ]

        -- Andreas, 2020-02-14, issue #4437
        -- Define data projections as projection-like from the start.
        TCM () -> TCM ()
    forall a. TCM a -> TCM a
    noMutualBlock (TCM () -> TCM ()) -> TCM () -> TCM ()
    forall a b. (a -> b) -> a -> b
    $ do
          let cs :: [Clause]
    cs = [ Clause
    clause ]
          (mst, _, cc) <- Maybe (QName, Type)
    -> [Clause] -> TCMT IO (Maybe SplitTree, Bool, CompiledClauses)
    compileClauses Maybe (QName, Type)
    forall a. Maybe a
    Nothing [Clause]
    cs
          fun          <- emptyFunctionData <&> \FunctionData
    fun -> FunctionData
    fun
                    { _funClauses    = cs
                    , _funCompiled   = Just cc
                    , _funSplitTree  = mst
                    , _funProjection = Right Projection
                        { projProper   = Nothing
                        , projOrig     = projName
                        , projFromType = Arg (getArgInfo ty) dataName
                        , projIndex    = np + 1
                        , projLams     = ProjLams $ map (argFromDom . fmap fst) $ telToList projTel
                        }
                    , _funMutual     = Just []
                    , _funTerminates = Just True
                    }
          lang <- getLanguage
          inTopContext $ addConstant projName $
            (defaultDefn defaultArgInfo projName (unDom projType) lang $ FunctionDefn fun)
              { defNoCompilation  = True
              , defArgOccurrences = [StrictPos]
              }

          reportSDoc "tc.data.proj.fun" 60 $ inTopContext $ vcat
            [ "proj" <+> prettyTCM i
            , nest 2 $ pretty fun
            ]

    freshAbstractQName'_ :: String -> TCM QName
    freshAbstractQName'_ :: String -> TCMT IO QName
    freshAbstractQName'_ = Fixity' -> Name -> TCMT IO QName
    freshAbstractQName Fixity'
    noFixity' (Name -> TCMT IO QName)
    -> (String -> Name) -> String -> TCMT IO QName
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> Name
    C.simpleName

    -- | Defines and returns the name of the `transpIx` function.
    defineTranspIx :: QName  -- ^ datatype name
                   -> TCM (Maybe QName)
    defineTranspIx :: QName -> TCMT IO (Maybe QName)
    defineTranspIx QName
    d = do
      def <- QName -> TCMT IO Definition
    forall (m :: * -> *). HasConstInfo m => QName -> m Definition
    getConstInfo QName
    d
      case theDef def of
        Datatype { dataPars :: Defn -> Nat
    dataPars = Nat
    npars
                 , dataIxs :: Defn -> Nat
    dataIxs = Nat
    nixs
                 , dataSort :: Defn -> Sort' Term
    dataSort = Sort' Term
    s}
         -> do
          let t :: Type
    t = Definition -> Type
    defType Definition
    def
          String -> Nat -> TCMT IO Doc -> TCM ()
    forall (m :: * -> *).
    MonadDebug m =>
    String -> Nat -> TCMT IO Doc -> m ()
    reportSDoc String
    "tc.data.ixs" Nat
    20 (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
    "name :" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> QName -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    forall (m :: * -> *). MonadPretty m => QName -> m Doc
    prettyTCM QName
    d
            , TCMT IO Doc
    "type :" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> Type -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    forall (m :: * -> *). MonadPretty m => Type -> m Doc
    prettyTCM Type
    t
            , TCMT IO Doc
    "npars:" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> Nat -> TCMT IO Doc
    forall (m :: * -> *) a. (Applicative m, Pretty a) => a -> m Doc
    pretty Nat
    npars
            , TCMT IO Doc
    "nixs :" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> Nat -> TCMT IO Doc
    forall (m :: * -> *) a. (Applicative m, Pretty a) => a -> m Doc
    pretty Nat
    nixs
            ]
          if Nat
    nixs Nat -> Nat -> Bool
    forall a. Eq a => a -> a -> Bool
    == Nat
    0 then Maybe QName -> TCMT IO (Maybe QName)
    forall a. a -> TCMT IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe QName
    forall a. Maybe a
    Nothing else do
          trIx <- String -> TCMT IO QName
    freshAbstractQName'_ (String -> TCMT IO QName) -> String -> TCMT IO QName
    forall a b. (a -> b) -> a -> b
    $ String
    "transpX-" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Name -> String
    forall a. Pretty a => a -> String
    P.prettyShow (QName -> Name
    A.qnameName QName
    d)
          TelV params t' <- telViewUpTo npars t
          TelV ixs    dT <- telViewUpTo nixs t'
          -- params     ⊢ s
          -- params     ⊢ ixs
          -- params.ixs ⊢ dT
          reportSDoc "tc.data.ixs" 20 $ vcat
            [ "params :" <+> prettyTCM params
            , "ixs    :" <+> addContext params (prettyTCM ixs)
            , "dT     :" <+> addContext params (addContext ixs $ prettyTCM dT)
            ]
          -- theType <- abstract params <$> undefined
          interval <- primIntervalType
          let deltaI = Type -> Tele (Dom Type) -> Tele (Dom Type)
    expTelescope Type
    interval Tele (Dom Type)
    ixs
          iz <- primIZero
          io@(Con c _ _) <- primIOne
          imin <- getPrimitiveTerm builtinIMin
          imax <- getPrimitiveTerm builtinIMax
          ineg <- getPrimitiveTerm builtinINeg
          transp <- getPrimitiveTerm builtinTrans
          por <- getPrimitiveTerm builtinPOr
          one <- primItIsOne
          -- reportSDoc "trans.rec" 20 $ text $ show params
          -- reportSDoc "trans.rec" 20 $ text $ show deltaI
          -- reportSDoc "trans.rec" 10 $ text $ show fsT

          -- let thePrefix = "transp-"
          -- theName <- freshAbstractQName'_ $ thePrefix ++ P.prettyShow (A.qnameName name)

          -- reportSLn "trans.rec" 5 $ ("Generated name: " ++ show theName ++ " " ++ showQNameId theName)

          -- record type in 'exponentiated' context
          -- (params : Γ)(ixs : Δ^I), i : I |- T[params, ixs i]
          let rect' = Tele (Dom Type) -> Substitution
    forall {a}. Sized a => a -> Substitution
    sub Tele (Dom Type)
    ixs Substitution' (SubstArg Type) -> Type -> Type
    forall a. Subst a => Substitution' (SubstArg a) -> a -> a
    `applySubst` Sort' Term -> Term -> Type
    forall t a. Sort' t -> a -> Type'' t a
    El (Nat -> Sort' Term -> Sort' Term
    forall a. Subst a => Nat -> a -> a
    raise (Tele (Dom Type) -> Nat
    forall a. Sized a => a -> Nat
    size Tele (Dom Type)
    ixs) Sort' Term
    s) (QName -> [Elim' Term] -> Term
    Def QName
    d (Tele (Dom Type) -> Boundary -> [Elim' Term]
    forall a.
    DeBruijn a =>
    Tele (Dom Type) -> Boundary' Nat a -> [Elim' a]
    teleElims (Tele (Dom Type) -> Tele (Dom Type) -> Tele (Dom Type)
    forall t. Abstract t => Tele (Dom Type) -> t -> t
    abstract Tele (Dom Type)
    params Tele (Dom Type)
    ixs) Boundary
    forall a. Null a => a
    empty))
          addContext params $ reportSDoc "tc.data.ixs" 20 $ "deltaI:" <+> prettyTCM deltaI
          addContext params $ addContext deltaI $ addContext ("i"::String, defaultDom interval) $ do
            reportSDoc "tc.data.ixs" 20 $ "rect':" <+> pretty (sub ixs)
            reportSDoc "tc.data.ixs" 20 $ "rect':" <+> pretty rect'

          theType <- (abstract (setHiding Hidden <$> params) <$>) . (abstract deltaI <$>) $ runNamesT [] $ do
                      rect' <- open (runNames [] $ bind "i" $ \ forall b. (Subst b, DeBruijn b) => NamesT Identity b
    x -> let NamesT Identity Term
    _ = NamesT Identity Term
    forall b. (Subst b, DeBruijn b) => NamesT Identity b
    x NamesT Identity Term
    -> NamesT Identity Term -> NamesT Identity Term
    forall a. a -> a -> a
    `asTypeOf` Term -> NamesT Identity Term
    forall a. a -> NamesT Identity a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Term
    forall a. HasCallStack => a
    undefined :: Term) in
                                                                     Type -> NamesT Identity Type
    forall a. a -> NamesT Identity a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Type
    rect')
                      nPi' "phi" (primIntervalType) $ \ NamesT (TCMT IO) Term
    phi ->
                       (Abs Type -> Term -> Type
    Abs Type -> SubstArg Type -> Type
    forall a. Subst a => Abs a -> SubstArg a -> a
    absApp (Abs Type -> Term -> Type)
    -> NamesT (TCMT IO) (Abs Type) -> NamesT (TCMT IO) (Term -> Type)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> NamesT (TCMT IO) (Abs Type)
    rect' NamesT (TCMT IO) (Term -> Type)
    -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
    forall a b.
    NamesT (TCMT IO) (a -> b)
    -> NamesT (TCMT IO) a -> NamesT (TCMT IO) b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Term -> NamesT (TCMT IO) Term
    forall a. a -> NamesT (TCMT IO) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Term
    iz) NamesT (TCMT IO) Type
    -> NamesT (TCMT IO) Type -> NamesT (TCMT IO) Type
    forall (m :: * -> *). Applicative m => m Type -> m Type -> m Type
    --> (Abs Type -> Term -> Type
    Abs Type -> SubstArg Type -> Type
    forall a. Subst a => Abs a -> SubstArg a -> a
    absApp (Abs Type -> Term -> Type)
    -> NamesT (TCMT IO) (Abs Type) -> NamesT (TCMT IO) (Term -> Type)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> NamesT (TCMT IO) (Abs Type)
    rect' NamesT (TCMT IO) (Term -> Type)
    -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
    forall a b.
    NamesT (TCMT IO) (a -> b)
    -> NamesT (TCMT IO) a -> NamesT (TCMT IO) b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Term -> NamesT (TCMT IO) Term
    forall a. a -> NamesT (TCMT IO) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Term
    io)

          reportSDoc "tc.data.ixs" 20 $ "transpIx:" <+> prettyTCM theType
          let
            ctel = Tele (Dom Type) -> Tele (Dom Type) -> Tele (Dom Type)
    forall t. Abstract t => Tele (Dom Type) -> t -> t
    abstract Tele (Dom Type)
    params (Tele (Dom Type) -> Tele (Dom Type))
    -> Tele (Dom Type) -> Tele (Dom Type)
    forall a b. (a -> b) -> a -> b
    $ Tele (Dom Type) -> Tele (Dom Type) -> Tele (Dom Type)
    forall t. Abstract t => Tele (Dom Type) -> t -> t
    abstract Tele (Dom Type)
    deltaI (Tele (Dom Type) -> Tele (Dom Type))
    -> Tele (Dom Type) -> Tele (Dom Type)
    forall a b. (a -> b) -> a -> b
    $ Dom Type -> Abs (Tele (Dom Type)) -> Tele (Dom Type)
    forall a. a -> Abs (Tele a) -> Tele a
    ExtendTel (Type -> Dom Type
    forall a. a -> Dom a
    defaultDom (Type -> Dom Type) -> Type -> Dom Type
    forall a b. (a -> b) -> a -> b
    $ Nat -> SubstArg Type -> Type -> Type
    forall a. Subst a => Nat -> SubstArg a -> a -> a
    subst Nat
    0 Term
    SubstArg Type
    iz Type
    rect') (String -> Tele (Dom Type) -> Abs (Tele (Dom Type))
    forall a. String -> a -> Abs a
    Abs String
    "t" Tele (Dom Type)
    forall a. Tele a
    EmptyTel)
            ps = Tele (Dom Type) -> Boundary -> [Arg (Named_ (Pattern' DBPatVar))]
    forall a.
    DeBruijn a =>
    Tele (Dom Type) -> Boundary -> [NamedArg (Pattern' a)]
    telePatterns Tele (Dom Type)
    ctel Boundary
    forall a. Null a => a
    empty
            cpi = ConPatternInfo
    noConPatternInfo { conPType = Just (defaultArg interval) }
            pat :: NamedArg (Pattern' DBPatVar)
            pat = Pattern' DBPatVar -> Arg (Named_ (Pattern' DBPatVar))
    forall a. a -> NamedArg a
    defaultNamedArg (Pattern' DBPatVar -> Arg (Named_ (Pattern' DBPatVar)))
    -> Pattern' DBPatVar -> Arg (Named_ (Pattern' DBPatVar))
    forall a b. (a -> b) -> a -> b
    $ ConHead
    -> ConPatternInfo
    -> [Arg (Named_ (Pattern' DBPatVar))]
    -> Pattern' DBPatVar
    forall x.
    ConHead -> ConPatternInfo -> [NamedArg (Pattern' x)] -> Pattern' x
    ConP ConHead
    c ConPatternInfo
    cpi []
            clause = Clause
    forall a. Null a => a
    empty
              { clauseTel         = ctel
              , namedClausePats   = init ps ++ [pat, last ps]

              , clauseBody        = Just $ var 0
              , clauseType        = Just $ defaultArg $ raise 1 $ subst 0 io rect'
              , clauseRecursive   = Just False  -- non-recursive
              , clauseUnreachable = Just False
              }

          noMutualBlock $ do
            let cs = [ Clause
    clause ]
    --        we do not compile clauses as that leads to throwing missing clauses errors.
    --        (mst, _, cc) <- compileClauses Nothing cs
            fun <- emptyFunctionData <&> \FunctionData
    fun -> FunctionData
    fun
                      { _funClauses    = cs
                   --   , _funCompiled   = Just cc
                   --   , _funSplitTree  = mst
                      , _funProjection = Left MaybeProjection
                      , _funMutual     = Just []
                      , _funTerminates = Just True
                      , _funIsKanOp    = Just d
                      }
            inTopContext $ do
             reportSDoc "tc.transpx.type" 15 $ vcat
               [ "type of" <+> prettyTCM trIx <+> ":"
               , nest 2 $ prettyTCM theType
               ]

             addConstant trIx $
              (defaultDefn defaultArgInfo trIx theType (Cubical CErased) $ FunctionDefn fun)
                { defNoCompilation  = True
                }

            -- reportSDoc "tc.data.proj.fun" 60 $ inTopContext $ vcat
            --   [ "proj" <+> prettyTCM i
            --   , nest 2 $ pretty fun
            --   ]
          -- addContext ctel $ do
          --   let es = teleElims ctel []
          --   r <- reduce $ Def trIx es
          --   reportSDoc "tc.data.ixs" 20 $ "reducedx:" <+> prettyTCM r
          --   r <- reduce $ Def trIx (init es ++ [Apply $ argN io, last es])
          --   reportSDoc "tc.data.ixs" 20 $ "reduced1:" <+> prettyTCM r
          return $ Just trIx
        Defn
    _ -> TCMT IO (Maybe QName)
    forall a. HasCallStack => a
    __IMPOSSIBLE__
      where

        -- Γ, Δ^I, i : I |- sub (Γ ⊢ Δ) : Γ, Δ
        sub :: a -> Substitution
    sub a
    tel = Nat -> Substitution
    expS (Nat -> Substitution) -> Nat -> Substitution
    forall a b. (a -> b) -> a -> b
    $ a -> Nat
    forall a. Sized a => a -> Nat
    size a
    tel

    defineTranspFun :: QName -- ^ datatype
                    -> Maybe QName -- ^ transpX "constructor"
                    -> [QName]     -- ^ constructor names
                    -> [QName]     -- ^ path cons
                    -> TCM (Maybe QName) -- transp function for the datatype.
    defineTranspFun :: QName -> Maybe QName -> [QName] -> [QName] -> TCMT IO (Maybe QName)
    defineTranspFun QName
    d Maybe QName
    mtrX [QName]
    cons [QName]
    pathCons = do
      def <- QName -> TCMT IO Definition
    forall (m :: * -> *). HasConstInfo m => QName -> m Definition
    getConstInfo QName
    d
      case theDef def of
        Datatype { dataPars :: Defn -> Nat
    dataPars = Nat
    npars
                 , dataIxs :: Defn -> Nat
    dataIxs = Nat
    nixs
                 , dataSort :: Defn -> Sort' Term
    dataSort = s :: Sort' Term
    s@(Type Level
    _)
    --             , dataCons = cons -- not there yet
                 }
         -> do
          let t :: Type
    t = Definition -> Type
    defType Definition
    def
          String -> Nat -> TCMT IO Doc -> TCM ()
    forall (m :: * -> *).
    MonadDebug m =>
    String -> Nat -> TCMT IO Doc -> m ()
    reportSDoc String
    "tc.data.transp" Nat
    20 (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
    "name :" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> QName -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    forall (m :: * -> *). MonadPretty m => QName -> m Doc
    prettyTCM QName
    d
            , TCMT IO Doc
    "type :" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> Type -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    forall (m :: * -> *). MonadPretty m => Type -> m Doc
    prettyTCM Type
    t
            , TCMT IO Doc
    "npars:" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> Nat -> TCMT IO Doc
    forall (m :: * -> *) a. (Applicative m, Pretty a) => a -> m Doc
    pretty Nat
    npars
            , TCMT IO Doc
    "nixs :" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> Nat -> TCMT IO Doc
    forall (m :: * -> *) a. (Applicative m, Pretty a) => a -> m Doc
    pretty Nat
    nixs
            ]
          trD <- String -> TCMT IO QName
    freshAbstractQName'_ (String -> TCMT IO QName) -> String -> TCMT IO QName
    forall a b. (a -> b) -> a -> b
    $ String
    "transp" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Name -> String
    forall a. Pretty a => a -> String
    P.prettyShow (QName -> Name
    A.qnameName QName
    d)
          TelV params t' <- telViewUpTo npars t
          TelV ixs    dT <- telViewUpTo nixs t'

          let tel = Tele (Dom Type) -> Tele (Dom Type) -> Tele (Dom Type)
    forall t. Abstract t => Tele (Dom Type) -> t -> t
    abstract Tele (Dom Type)
    params Tele (Dom Type)
    ixs
          mixs <- runMaybeT $ traverse (traverse (MaybeT . toLType)) ixs
          caseMaybe mixs (return Nothing) $ \ Tele (Dom LType)
    _ -> do

          io@(Con io_c _ []) <- TCMT IO Term
    forall (m :: * -> *).
    (HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
    m Term
    primIOne
          iz <- primIZero

          interval <- primIntervalType
          let telI = Type -> Tele (Dom Type) -> Tele (Dom Type)
    expTelescope Type
    interval Tele (Dom Type)
    tel
              sigma = Tele (Dom Type) -> Substitution
    forall {a}. Sized a => a -> Substitution
    sub Tele (Dom Type)
    tel
              dTs = (Substitution
    Substitution' (SubstArg Type)
    sigma Substitution' (SubstArg Type) -> Type -> Type
    forall a. Subst a => Substitution' (SubstArg a) -> a -> a
    `applySubst` Sort' Term -> Term -> Type
    forall t a. Sort' t -> a -> Type'' t a
    El Sort' Term
    s (QName -> [Elim' Term] -> Term
    Def QName
    d ([Elim' Term] -> Term) -> [Elim' Term] -> Term
    forall a b. (a -> b) -> a -> b
    $ (Arg Term -> Elim' Term) -> [Arg Term] -> [Elim' Term]
    forall a b. (a -> b) -> [a] -> [b]
    map Arg Term -> Elim' Term
    forall a. Arg a -> Elim' a
    Apply ([Arg Term] -> [Elim' Term]) -> [Arg Term] -> [Elim' Term]
    forall a b. (a -> b) -> a -> b
    $ Tele (Dom Type) -> [Arg Term]
    forall a t. DeBruijn a => Tele (Dom t) -> [Arg a]
    teleArgs Tele (Dom Type)
    tel))

          theType <- (abstract telI <$>) $ runNamesT [] $ do
                      dT <- open $ Abs "i" $ dTs
                      nPi' "phi" primIntervalType $ \ NamesT (TCMT IO) Term
    phi ->
                       (Abs Type -> Term -> Type
    Abs Type -> SubstArg Type -> Type
    forall a. Subst a => Abs a -> SubstArg a -> a
    absApp (Abs Type -> Term -> Type)
    -> NamesT (TCMT IO) (Abs Type) -> NamesT (TCMT IO) (Term -> Type)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> NamesT (TCMT IO) (Abs Type)
    dT NamesT (TCMT IO) (Term -> Type)
    -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
    forall a b.
    NamesT (TCMT IO) (a -> b)
    -> NamesT (TCMT IO) a -> NamesT (TCMT IO) b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Term -> NamesT (TCMT IO) Term
    forall a. a -> NamesT (TCMT IO) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Term
    iz) NamesT (TCMT IO) Type
    -> NamesT (TCMT IO) Type -> NamesT (TCMT IO) Type
    forall (m :: * -> *). Applicative m => m Type -> m Type -> m Type
    --> (Abs Type -> Term -> Type
    Abs Type -> SubstArg Type -> Type
    forall a. Subst a => Abs a -> SubstArg a -> a
    absApp (Abs Type -> Term -> Type)
    -> NamesT (TCMT IO) (Abs Type) -> NamesT (TCMT IO) (Term -> Type)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> NamesT (TCMT IO) (Abs Type)
    dT NamesT (TCMT IO) (Term -> Type)
    -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
    forall a b.
    NamesT (TCMT IO) (a -> b)
    -> NamesT (TCMT IO) a -> NamesT (TCMT IO) b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Term -> NamesT (TCMT IO) Term
    forall a. a -> NamesT (TCMT IO) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Term
    io)

          reportSDoc "tc.data.transp" 20 $ "transpD:" <+> prettyTCM theType

          noMutualBlock $ do
            fun <- emptyFunction
            inTopContext $ addConstant trD $
              (defaultDefn defaultArgInfo trD theType (Cubical CErased) fun)
            let
              ctel = Tele (Dom Type) -> Tele (Dom Type) -> Tele (Dom Type)
    forall t. Abstract t => Tele (Dom Type) -> t -> t
    abstract Tele (Dom Type)
    telI (Tele (Dom Type) -> Tele (Dom Type))
    -> Tele (Dom Type) -> Tele (Dom Type)
    forall a b. (a -> b) -> a -> b
    $ Dom Type -> Abs (Tele (Dom Type)) -> Tele (Dom Type)
    forall a. a -> Abs (Tele a) -> Tele a
    ExtendTel (Type -> Dom Type
    forall a. a -> Dom a
    defaultDom (Type -> Dom Type) -> Type -> Dom Type
    forall a b. (a -> b) -> a -> b
    $ Nat -> SubstArg Type -> Type -> Type
    forall a. Subst a => Nat -> SubstArg a -> a -> a
    subst Nat
    0 Term
    SubstArg Type
    iz Type
    dTs) (String -> Tele (Dom Type) -> Abs (Tele (Dom Type))
    forall a. String -> a -> Abs a
    Abs String
    "t" Tele (Dom Type)
    forall a. Tele a
    EmptyTel)
              ps = Tele (Dom Type) -> Boundary -> [Arg (Named_ (Pattern' DBPatVar))]
    forall a.
    DeBruijn a =>
    Tele (Dom Type) -> Boundary -> [NamedArg (Pattern' a)]
    telePatterns Tele (Dom Type)
    ctel Boundary
    forall a. Null a => a
    empty
              cpi = ConPatternInfo
    noConPatternInfo { conPType = Just (defaultArg interval)
                                     , conPFallThrough = True
                                     }
              pat :: NamedArg (Pattern' DBPatVar)
              pat = Pattern' DBPatVar -> Arg (Named_ (Pattern' DBPatVar))
    forall a. a -> NamedArg a
    defaultNamedArg (Pattern' DBPatVar -> Arg (Named_ (Pattern' DBPatVar)))
    -> Pattern' DBPatVar -> Arg (Named_ (Pattern' DBPatVar))
    forall a b. (a -> b) -> a -> b
    $ ConHead
    -> ConPatternInfo
    -> [Arg (Named_ (Pattern' DBPatVar))]
    -> Pattern' DBPatVar
    forall x.
    ConHead -> ConPatternInfo -> [NamedArg (Pattern' x)] -> Pattern' x
    ConP ConHead
    io_c ConPatternInfo
    cpi []
              clause = Clause
    forall a. Null a => a
    empty
                { clauseTel         = ctel
                , namedClausePats   = init ps ++ [pat, last ps]

                , clauseBody        = Just $ var 0
                , clauseType        = Just $ defaultArg $ raise 1 $ subst 0 io dTs
                , clauseRecursive   = Just False  -- non-recursive
                , clauseUnreachable = Just False
                }
            let debugNoTransp c
    cl = c -> (Abs a -> m ()) -> m ()
    forall (m :: * -> *) c a b.
    (MonadTCEnv m, ReadTCState m, LensClosure c a) =>
    c -> (a -> m b) -> m b
    enterClosure c
    cl ((Abs a -> m ()) -> m ()) -> (Abs a -> m ()) -> m ()
    forall a b. (a -> b) -> a -> b
    $ \ Abs a
    t -> do
                  String -> Nat -> TCMT IO Doc -> m ()
    forall (m :: * -> *).
    MonadDebug m =>
    String -> Nat -> TCMT IO Doc -> m ()
    reportSDoc String
    "tc.data.transp" Nat
    20 (TCMT IO Doc -> m ()) -> TCMT IO Doc -> m ()
    forall a b. (a -> b) -> a -> b
    $ (String, 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 =>
    (String, Dom Type) -> m a -> m a
    addContext (String
    "i" :: String, Dom Type
    HasCallStack => Dom Type
    __DUMMY_DOM__) (TCMT IO Doc -> TCMT IO Doc) -> TCMT IO Doc -> TCMT IO Doc
    forall a b. (a -> b) -> a -> b
    $
                    TCMT IO Doc
    "could not transp" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> a -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    forall (m :: * -> *). MonadPretty m => a -> m Doc
    prettyTCM (Abs a -> a
    forall a. Subst a => Abs a -> a
    absBody Abs a
    t)
            -- TODO: if no params nor indexes trD phi u0 = u0.
            ecs <- tryTranspError $ (clause:) <$> defineConClause trD (not $ null pathCons) mtrX npars nixs ixs telI sigma dTs cons
            caseEitherM (pure ecs) (\ Closure (Abs Type)
    cl -> Closure (Abs Type) -> TCM ()
    forall {m :: * -> *} {c} {a}.
    (MonadTCEnv m, ReadTCState m, LensClosure c (Abs a), MonadDebug m,
     PrettyTCM a, Subst a) =>
    c -> m ()
    debugNoTransp Closure (Abs Type)
    cl TCM () -> TCMT IO (Maybe QName) -> TCMT IO (Maybe QName)
    forall a b. TCMT IO a -> TCMT IO b -> TCMT IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Maybe QName -> TCMT IO (Maybe QName)
    forall a. a -> TCMT IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe QName
    forall a. Maybe a
    Nothing) $ \ [Clause]
    cs -> do
            (mst, _, cc) <- Maybe (QName, Type)
    -> [Clause] -> TCMT IO (Maybe SplitTree, Bool, CompiledClauses)
    compileClauses Maybe (QName, Type)
    forall a. Maybe a
    Nothing [Clause]
    cs
            fun <- emptyFunctionData <&> \FunctionData
    fun -> FunctionData
    fun
                      { _funClauses    = cs
                      , _funCompiled   = Just cc
                      , _funSplitTree  = mst
                      , _funProjection = Left MaybeProjection
                      , _funMutual     = Just []
                      , _funTerminates = Just True
                      , _funIsKanOp    = Just d
                      }
            inTopContext $ addConstant trD $
              (defaultDefn defaultArgInfo trD theType (Cubical CErased) $ FunctionDefn fun)
                { defNoCompilation  = True
                }
            reportSDoc "tc.data.transp" 20 $ sep
              [ "transp: compiled clauses of " <+> prettyTCM trD
              , nest 2 $ return $ P.pretty cc
              ]

            return $ Just trD

        Datatype {} -> Maybe QName -> TCMT IO (Maybe QName)
    forall a. a -> TCMT IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe QName
    forall a. Maybe a
    Nothing
        Defn
    _           -> TCMT IO (Maybe QName)
    forall a. HasCallStack => a
    __IMPOSSIBLE__
      where
        -- Γ, Δ^I, i : I |- sub (Γ ⊢ Δ) : Γ, Δ
        sub :: a -> Substitution
    sub a
    tel = Nat -> Substitution
    expS (a -> Nat
    forall a. Sized a => a -> Nat
    size a
    tel)

    defineConClause :: QName -- ^ trD
                    -> Bool  -- ^ HIT
                    -> Maybe QName -- ^ trX
                    -> Nat  -- ^ npars = size Δ
                    -> Nat  -- ^ nixs = size X
                    -> Telescope -- ^ Δ ⊢ X
                    -> Telescope -- ^ (Δ.X)^I
                    -> Substitution -- ^ (Δ.X)^I, i : I ⊢ σ : Δ.X
                    -> Type       -- ^ (Δ.X)^I, i : I ⊢ D[δ i,x i] -- datatype
                    -> [QName]      -- ^ Constructors
                    -> TCM [Clause]
    defineConClause :: QName
    -> Bool
    -> Maybe QName
    -> Nat
    -> Nat
    -> Tele (Dom Type)
    -> Tele (Dom Type)
    -> Substitution
    -> Type
    -> [QName]
    -> TCM [Clause]
    defineConClause QName
    trD' Bool
    isHIT Maybe QName
    mtrX Nat
    npars Nat
    nixs Tele (Dom Type)
    xTel' Tele (Dom Type)
    telI Substitution
    sigma Type
    dT' [QName]
    cnames = do

      Bool -> TCM () -> TCM ()
    forall b (m :: * -> *). (IsBool b, Monad m) => b -> m () -> m ()
    unless (Maybe QName -> Bool
    forall a. Maybe a -> Bool
    isNothing Maybe QName
    mtrX Bool -> Bool -> Bool
    forall a. Eq a => a -> a -> Bool
    == (Nat
    nixs Nat -> Nat -> Bool
    forall a. Eq a => a -> a -> Bool
    == Nat
    0)) (TCM () -> TCM ()) -> TCM () -> TCM ()
    forall a b. (a -> b) -> a -> b
    $ TCM ()
    forall a. HasCallStack => a
    __IMPOSSIBLE__

      io <- TCMT IO Term
    forall (m :: * -> *).
    (HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
    m Term
    primIOne
      iz <- primIZero
      tHComp <- primHComp
      tINeg <- primINeg
      let max NamesT m Term
    i NamesT m Term
    j = m Term -> NamesT m Term
    forall (m :: * -> *) a. Monad m => m a -> NamesT m a
    cl m Term
    forall (m :: * -> *).
    (HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
    m Term
    primIMax NamesT m Term -> NamesT m Term -> NamesT m Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <@> NamesT m Term
    i NamesT m Term -> NamesT m Term -> NamesT m Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <@> NamesT m Term
    j
      let min NamesT m Term
    i NamesT m Term
    j = m Term -> NamesT m Term
    forall (m :: * -> *) a. Monad m => m a -> NamesT m a
    cl m Term
    forall (m :: * -> *).
    (HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
    m Term
    primIMin NamesT m Term -> NamesT m Term -> NamesT m Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <@> NamesT m Term
    i NamesT m Term -> NamesT m Term -> NamesT m Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <@> NamesT m Term
    j
      let neg NamesT m Term
    i = m Term -> NamesT m Term
    forall (m :: * -> *) a. Monad m => m a -> NamesT m a
    cl m Term
    forall (m :: * -> *).
    (HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
    m Term
    primINeg NamesT m Term -> NamesT m Term -> NamesT m Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <@> NamesT m Term
    i
      let hcomp NamesT (TCMT IO) Type
    ty [(NamesT (TCMT IO) Term, NamesT (TCMT IO) Term)]
    sys NamesT (TCMT IO) Term
    u0 = do
              ty <- NamesT (TCMT IO) Type
    ty
              LEl l ty <- fromMaybe __IMPOSSIBLE__ <$> toLType ty
              l <- open $ Level l
              ty <- open $ ty
              face <- (foldr max (pure iz) $ map fst $ sys)
              sys <- lam "i'" $ \ NamesT (TCMT IO) Term
    i -> NamesT (TCMT IO) Term
    -> NamesT (TCMT IO) Term
    -> [(NamesT (TCMT IO) Term, NamesT (TCMT IO) Term)]
    -> NamesT (TCMT IO) Term
    forall (m :: * -> *).
    HasBuiltins m =>
    NamesT m Term
    -> NamesT m Term
    -> [(NamesT m Term, NamesT m Term)]
    -> NamesT m Term
    combineSys NamesT (TCMT IO) Term
    l NamesT (TCMT IO) Term
    ty [(NamesT (TCMT IO) Term
    phi, NamesT (TCMT IO) Term
    u NamesT (TCMT IO) Term
    -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <@> NamesT (TCMT IO) Term
    i) | (NamesT (TCMT IO) Term
    phi,NamesT (TCMT IO) Term
    u) <- [(NamesT (TCMT IO) Term, NamesT (TCMT IO) Term)]
    sys]
              pure tHComp <#> l <#> ty <#> pure face <@> pure sys <@> u0
      interval <- primIntervalType
      let intervalTel String
    nm = Dom Type -> Abs (Tele (Dom Type)) -> Tele (Dom Type)
    forall a. a -> Abs (Tele a) -> Tele a
    ExtendTel (Type -> Dom Type
    forall a. a -> Dom a
    defaultDom Type
    interval) (String -> Tele (Dom Type) -> Abs (Tele (Dom Type))
    forall a. String -> a -> Abs a
    Abs String
    nm Tele (Dom Type)
    forall a. Tele a
    EmptyTel)

      let (parI,ixsI) = splitTelescopeAt npars telI
      let
        abstract_trD :: Monad m => (Vars m -> Vars m -> Vars m -> NamesT m Telescope) -> NamesT m Telescope
        abstract_trD Vars m -> Vars m -> Vars m -> NamesT m (Tele (Dom Type))
    k = do
                   ixsI <- AbsN (Tele (Dom Type))
    -> NamesT m (NamesT m (AbsN (Tele (Dom Type))))
    forall (m :: * -> *) a.
    (Monad m, Subst a) =>
    a -> NamesT m (NamesT m a)
    open (AbsN (Tele (Dom Type))
     -> NamesT m (NamesT m (AbsN (Tele (Dom Type)))))
    -> AbsN (Tele (Dom Type))
    -> NamesT m (NamesT m (AbsN (Tele (Dom Type))))
    forall a b. (a -> b) -> a -> b
    $ Names -> Tele (Dom Type) -> AbsN (Tele (Dom Type))
    forall a. Names -> a -> AbsN a
    AbsN (Tele (Dom Type) -> Names
    teleNames Tele (Dom Type)
    parI) Tele (Dom Type)
    ixsI
                   parI <- open parI
                   abstractN parI $ \ Vars m
    delta -> do
                   NamesT m (Tele (Dom Type))
    -> (Vars m -> NamesT m (Tele (Dom Type)))
    -> NamesT m (Tele (Dom Type))
    forall (m :: * -> *) a.
    (Monad m, Abstract a) =>
    NamesT m (Tele (Dom Type)) -> (Vars m -> NamesT m a) -> NamesT m a
    abstractN (NamesT m (AbsN (Tele (Dom Type)))
    ixsI NamesT m (AbsN (Tele (Dom Type)))
    -> [NamesT m (SubstArg (Tele (Dom Type)))]
    -> NamesT m (Tele (Dom Type))
    forall (m :: * -> *) a.
    (Monad m, Subst a) =>
    NamesT m (AbsN a) -> [NamesT m (SubstArg a)] -> NamesT m a
    `applyN` [NamesT m Term]
    [NamesT m (SubstArg (Tele (Dom Type)))]
    Vars m
    delta) ((Vars m -> NamesT m (Tele (Dom Type)))
     -> NamesT m (Tele (Dom Type)))
    -> (Vars m -> NamesT m (Tele (Dom Type)))
    -> NamesT m (Tele (Dom Type))
    forall a b. (a -> b) -> a -> b
    $ \ Vars m
    x -> do
                   NamesT m (Tele (Dom Type))
    -> (Vars m -> NamesT m (Tele (Dom Type)))
    -> NamesT m (Tele (Dom Type))
    forall (m :: * -> *) a.
    (Monad m, Abstract a) =>
    NamesT m (Tele (Dom Type)) -> (Vars m -> NamesT m a) -> NamesT m a
    abstractN (Tele (Dom Type) -> NamesT m (Tele (Dom Type))
    forall a. a -> NamesT m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Tele (Dom Type) -> NamesT m (Tele (Dom Type)))
    -> Tele (Dom Type) -> NamesT m (Tele (Dom Type))
    forall a b. (a -> b) -> a -> b
    $ String -> Tele (Dom Type)
    intervalTel String
    "phi") ((Vars m -> NamesT m (Tele (Dom Type)))
     -> NamesT m (Tele (Dom Type)))
    -> (Vars m -> NamesT m (Tele (Dom Type)))
    -> NamesT m (Tele (Dom Type))
    forall a b. (a -> b) -> a -> b
    $ \ Vars m
    phi -> do
                   Vars m -> Vars m -> Vars m -> NamesT m (Tele (Dom Type))
    k [NamesT m b]
    Vars m
    delta [NamesT m b]
    Vars m
    x [NamesT m b]
    Vars m
    phi
        bind_trD :: Monad m => (ArgVars m -> ArgVars m -> ArgVars m -> NamesT m b) ->
                    NamesT m (AbsN (AbsN (AbsN b)))
        bind_trD ArgVars m -> ArgVars m -> ArgVars m -> NamesT m b
    k = do
          [Arg String]
    -> (ArgVars m -> NamesT m (AbsN (AbsN b)))
    -> NamesT m (AbsN (AbsN (AbsN b)))
    forall (m :: * -> *) a.
    Monad m =>
    [Arg String] -> (ArgVars m -> NamesT m a) -> NamesT m (AbsN a)
    bindNArg (Tele (Dom Type) -> [Arg String]
    teleArgNames Tele (Dom Type)
    parI) ((ArgVars m -> NamesT m (AbsN (AbsN b)))
     -> NamesT m (AbsN (AbsN (AbsN b))))
    -> (ArgVars m -> NamesT m (AbsN (AbsN b)))
    -> NamesT m (AbsN (AbsN (AbsN b)))
    forall a b. (a -> b) -> a -> b
    $ \ ArgVars m
    delta_ps -> do
          [Arg String]
    -> (ArgVars m -> NamesT m (AbsN b)) -> NamesT m (AbsN (AbsN b))
    forall (m :: * -> *) a.
    Monad m =>
    [Arg String] -> (ArgVars m -> NamesT m a) -> NamesT m (AbsN a)
    bindNArg (Tele (Dom Type) -> [Arg String]
    teleArgNames Tele (Dom Type)
    ixsI) ((ArgVars m -> NamesT m (AbsN b)) -> NamesT m (AbsN (AbsN b)))
    -> (ArgVars m -> NamesT m (AbsN b)) -> NamesT m (AbsN (AbsN b))
    forall a b. (a -> b) -> a -> b
    $ \ ArgVars m
    x_ps -> do
          [Arg String] -> (ArgVars m -> NamesT m b) -> NamesT m (AbsN b)
    forall (m :: * -> *) a.
    Monad m =>
    [Arg String] -> (ArgVars m -> NamesT m a) -> NamesT m (AbsN a)
    bindNArg (Tele (Dom Type) -> [Arg String]
    teleArgNames (Tele (Dom Type) -> [Arg String])
    -> Tele (Dom Type) -> [Arg String]
    forall a b. (a -> b) -> a -> b
    $ String -> Tele (Dom Type)
    intervalTel String
    "phi") ((ArgVars m -> NamesT m b) -> NamesT m (AbsN b))
    -> (ArgVars m -> NamesT m b) -> NamesT m (AbsN b)
    forall a b. (a -> b) -> a -> b
    $ \ ArgVars m
    phi_ps -> do
          ArgVars m -> ArgVars m -> ArgVars m -> NamesT m b
    k [NamesT m (Arg b)]
    ArgVars m
    delta_ps [NamesT m (Arg b)]
    ArgVars m
    x_ps [NamesT m (Arg b)]
    ArgVars m
    phi_ps
      let trD = [Arg String]
    -> (ArgVars (TCMT IO) -> NamesT (TCMT IO) (AbsN (AbsN Term)))
    -> NamesT (TCMT IO) (AbsN (AbsN (AbsN Term)))
    forall (m :: * -> *) a.
    Monad m =>
    [Arg String] -> (ArgVars m -> NamesT m a) -> NamesT m (AbsN a)
    bindNArg (Tele (Dom Type) -> [Arg String]
    teleArgNames Tele (Dom Type)
    parI) ((ArgVars (TCMT IO) -> NamesT (TCMT IO) (AbsN (AbsN Term)))
     -> NamesT (TCMT IO) (AbsN (AbsN (AbsN Term))))
    -> (ArgVars (TCMT IO) -> NamesT (TCMT IO) (AbsN (AbsN Term)))
    -> NamesT (TCMT IO) (AbsN (AbsN (AbsN Term)))
    forall a b. (a -> b) -> a -> b
    $ \ ArgVars (TCMT IO)
    delta ->
                [Arg String]
    -> (ArgVars (TCMT IO) -> NamesT (TCMT IO) (AbsN Term))
    -> NamesT (TCMT IO) (AbsN (AbsN Term))
    forall (m :: * -> *) a.
    Monad m =>
    [Arg String] -> (ArgVars m -> NamesT m a) -> NamesT m (AbsN a)
    bindNArg (Tele (Dom Type) -> [Arg String]
    teleArgNames Tele (Dom Type)
    ixsI) ((ArgVars (TCMT IO) -> NamesT (TCMT IO) (AbsN Term))
     -> NamesT (TCMT IO) (AbsN (AbsN Term)))
    -> (ArgVars (TCMT IO) -> NamesT (TCMT IO) (AbsN Term))
    -> NamesT (TCMT IO) (AbsN (AbsN Term))
    forall a b. (a -> b) -> a -> b
    $ \ ArgVars (TCMT IO)
    x ->
                Names
    -> (Vars (TCMT IO) -> NamesT (TCMT IO) Term)
    -> NamesT (TCMT IO) (AbsN Term)
    forall (m :: * -> *) a.
    Monad m =>
    Names -> (Vars m -> NamesT m a) -> NamesT m (AbsN a)
    bindN [String
    "phi",String
    "u0"]           ((Vars (TCMT IO) -> NamesT (TCMT IO) Term)
     -> NamesT (TCMT IO) (AbsN Term))
    -> (Vars (TCMT IO) -> NamesT (TCMT IO) Term)
    -> NamesT (TCMT IO) (AbsN Term)
    forall a b. (a -> b) -> a -> b
    $ \ [NamesT (TCMT IO) Term
    phi,NamesT (TCMT IO) Term
    u0] ->
                  ((QName -> [Elim' Term] -> Term
    Def QName
    trD' [] Term -> [Arg Term] -> Term
    forall t. Apply t => t -> [Arg Term] -> t
    `apply`) ([Arg Term] -> Term)
    -> NamesT (TCMT IO) [Arg Term] -> NamesT (TCMT IO) Term
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [NamesT (TCMT IO) (Arg Term)] -> NamesT (TCMT IO) [Arg Term]
    forall (t :: * -> *) (m :: * -> *) a.
    (Traversable t, Monad m) =>
    t (m a) -> m (t a)
    forall (m :: * -> *) a. Monad m => [m a] -> m [a]
    sequence ([NamesT (TCMT IO) (Arg Term)]
    ArgVars (TCMT IO)
    delta [NamesT (TCMT IO) (Arg Term)]
    -> [NamesT (TCMT IO) (Arg Term)] -> [NamesT (TCMT IO) (Arg Term)]
    forall a. [a] -> [a] -> [a]
    ++ [NamesT (TCMT IO) (Arg Term)]
    ArgVars (TCMT IO)
    x)) NamesT (TCMT IO) Term
    -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <@> NamesT (TCMT IO) Term
    phi NamesT (TCMT IO) Term
    -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <@> NamesT (TCMT IO) Term
    u0
      -- [Δ] ⊢ X
      let xTel = AbsN (Tele (Dom Type)) -> NamesT (TCMT IO) (AbsN (Tele (Dom Type)))
    forall a. a -> NamesT (TCMT IO) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (AbsN (Tele (Dom Type))
     -> NamesT (TCMT IO) (AbsN (Tele (Dom Type))))
    -> AbsN (Tele (Dom Type))
    -> NamesT (TCMT IO) (AbsN (Tele (Dom Type)))
    forall a b. (a -> b) -> a -> b
    $ Names -> Tele (Dom Type) -> AbsN (Tele (Dom Type))
    forall a. Names -> a -> AbsN a
    AbsN (Tele (Dom Type) -> Names
    teleNames Tele (Dom Type)
    parI) Tele (Dom Type)
    xTel'
      -- [δ : Δ^I, x : X^I, i : I] ⊢ D (δ i) (x i)
      let dT = AbsN Type -> NamesT (TCMT IO) (AbsN Type)
    forall a. a -> NamesT (TCMT IO) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (AbsN Type -> NamesT (TCMT IO) (AbsN Type))
    -> AbsN Type -> NamesT (TCMT IO) (AbsN Type)
    forall a b. (a -> b) -> a -> b
    $ Names -> Type -> AbsN Type
    forall a. Names -> a -> AbsN a
    AbsN (Tele (Dom Type) -> Names
    teleNames Tele (Dom Type)
    parI Names -> Names -> Names
    forall a. [a] -> [a] -> [a]
    ++ Tele (Dom Type) -> Names
    teleNames Tele (Dom Type)
    ixsI Names -> Names -> Names
    forall a. [a] -> [a] -> [a]
    ++ [String
    "i"]) Type
    dT'

      let hcompComputes = Bool -> Bool
    forall a. Boolean a => a -> a
    not (Bool -> Bool) -> Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $ Bool
    isHIT Bool -> Bool -> Bool
    forall a. Boolean a => a -> a -> a
    || Nat
    nixs Nat -> Nat -> Bool
    forall a. Ord a => a -> a -> Bool
    > Nat
    0
      c_HComp <- if hcompComputes then return [] else do
          reportSDoc "tc.data.transp.con" 20 $ "======================="
          reportSDoc "tc.data.transp.con" 20 $ "hcomp"
          qHComp <- fromMaybe __IMPOSSIBLE__ <$> getPrimitiveName' builtinHComp
          hcomp_ty <- defType <$> getConstInfo qHComp
          gamma <- runNamesT [] $ do
                   ixsI <- open $ AbsN (teleNames parI) ixsI
                   parI <- open parI
                   abstract_trD $ \ Vars (TCMT IO)
    delta Vars (TCMT IO)
    x Vars (TCMT IO)
    _ -> do
                   LEl l ty <- LType -> Maybe LType -> LType
    forall a. a -> Maybe a -> a
    fromMaybe LType
    forall a. HasCallStack => a
    __IMPOSSIBLE__ (Maybe LType -> LType)
    -> (Type -> NamesT (TCMT IO) (Maybe LType))
    -> Type
    -> NamesT (TCMT IO) LType
    forall (m :: * -> *) b c a.
    Functor m =>
    (b -> c) -> (a -> m b) -> a -> m c
    <.> Type -> NamesT (TCMT IO) (Maybe LType)
    forall (m :: * -> *). MonadReduce m => Type -> m (Maybe LType)
    toLType (Type -> NamesT (TCMT IO) LType)
    -> NamesT (TCMT IO) Type -> NamesT (TCMT IO) LType
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< (NamesT (TCMT IO) (AbsN Type)
    dT NamesT (TCMT IO) (AbsN Type)
    -> [NamesT (TCMT IO) (SubstArg Type)] -> NamesT (TCMT IO) Type
    forall (m :: * -> *) a.
    (Monad m, Subst a) =>
    NamesT m (AbsN a) -> [NamesT m (SubstArg a)] -> NamesT m a
    `applyN` ([NamesT (TCMT IO) Term]
    Vars (TCMT IO)
    delta [NamesT (TCMT IO) Term]
    -> [NamesT (TCMT IO) Term] -> [NamesT (TCMT IO) Term]
    forall a. [a] -> [a] -> [a]
    ++ [NamesT (TCMT IO) Term]
    Vars (TCMT IO)
    x [NamesT (TCMT IO) Term]
    -> [NamesT (TCMT IO) Term] -> [NamesT (TCMT IO) Term]
    forall a. [a] -> [a] -> [a]
    ++ [Term -> NamesT (TCMT IO) Term
    forall a. a -> NamesT (TCMT IO) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Term
    iz]))
                   -- (φ : I), (I → Partial φ (D (δ i0) (x i0))), D (δ i0) (x i0)
                   TelV args _ <- lift $ telView =<< piApplyM hcomp_ty [Level l,ty]
                   unless (size args == 3) __IMPOSSIBLE__
                   pure args
          res <- runNamesT [] $ do
            let hcompArgs = (String -> Arg String) -> Names -> [Arg String]
    forall a b. (a -> b) -> [a] -> [b]
    map String -> Arg String
    forall e. e -> Arg e
    argN [String
    "phi",String
    "u",String
    "u0"]
            bind_trD $ \ ArgVars (TCMT IO)
    delta_ps ArgVars (TCMT IO)
    x_ps ArgVars (TCMT IO)
    phi_ps -> do
            let x :: [NamesT (TCMT IO) Term]
    x = (NamesT (TCMT IO) (Arg Term) -> NamesT (TCMT IO) Term)
    -> [NamesT (TCMT IO) (Arg Term)] -> [NamesT (TCMT IO) Term]
    forall a b. (a -> b) -> [a] -> [b]
    map ((Arg Term -> Term)
    -> NamesT (TCMT IO) (Arg Term) -> NamesT (TCMT IO) Term
    forall a b. (a -> b) -> NamesT (TCMT IO) a -> NamesT (TCMT IO) b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Arg Term -> Term
    forall e. Arg e -> e
    unArg) [NamesT (TCMT IO) (Arg Term)]
    ArgVars (TCMT IO)
    x_ps
            let delta :: [NamesT (TCMT IO) Term]
    delta = (NamesT (TCMT IO) (Arg Term) -> NamesT (TCMT IO) Term)
    -> [NamesT (TCMT IO) (Arg Term)] -> [NamesT (TCMT IO) Term]
    forall a b. (a -> b) -> [a] -> [b]
    map ((Arg Term -> Term)
    -> NamesT (TCMT IO) (Arg Term) -> NamesT (TCMT IO) Term
    forall a b. (a -> b) -> NamesT (TCMT IO) a -> NamesT (TCMT IO) b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Arg Term -> Term
    forall e. Arg e -> e
    unArg) [NamesT (TCMT IO) (Arg Term)]
    ArgVars (TCMT IO)
    delta_ps
            let [NamesT (TCMT IO) Term
    phi] = (NamesT (TCMT IO) (Arg Term) -> NamesT (TCMT IO) Term)
    -> [NamesT (TCMT IO) (Arg Term)] -> [NamesT (TCMT IO) Term]
    forall a b. (a -> b) -> [a] -> [b]
    map ((Arg Term -> Term)
    -> NamesT (TCMT IO) (Arg Term) -> NamesT (TCMT IO) Term
    forall a b. (a -> b) -> NamesT (TCMT IO) a -> NamesT (TCMT IO) b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Arg Term -> Term
    forall e. Arg e -> e
    unArg) [NamesT (TCMT IO) (Arg Term)]
    ArgVars (TCMT IO)
    phi_ps
            [Arg String]
    -> (ArgVars (TCMT IO)
        -> NamesT
             (TCMT IO) ([Arg (Named_ (Pattern' DBPatVar))], Type, Term))
    -> NamesT
         (TCMT IO) (AbsN ([Arg (Named_ (Pattern' DBPatVar))], Type, Term))
    forall (m :: * -> *) a.
    Monad m =>
    [Arg String] -> (ArgVars m -> NamesT m a) -> NamesT m (AbsN a)
    bindNArg [Arg String]
    hcompArgs ((ArgVars (TCMT IO)
      -> NamesT
           (TCMT IO) ([Arg (Named_ (Pattern' DBPatVar))], Type, Term))
     -> NamesT
          (TCMT IO) (AbsN ([Arg (Named_ (Pattern' DBPatVar))], Type, Term)))
    -> (ArgVars (TCMT IO)
        -> NamesT
             (TCMT IO) ([Arg (Named_ (Pattern' DBPatVar))], Type, Term))
    -> NamesT
         (TCMT IO) (AbsN ([Arg (Named_ (Pattern' DBPatVar))], Type, Term))
    forall a b. (a -> b) -> a -> b
    $ \ ArgVars (TCMT IO)
    as0 -> do -- as0 : aTel[delta 0]
            let
              origPHComp :: NamesT (TCMT IO) (Pattern' DBPatVar)
    origPHComp = do
                LEl l t <- LType -> Maybe LType -> LType
    forall a. a -> Maybe a -> a
    fromMaybe LType
    forall a. HasCallStack => a
    __IMPOSSIBLE__ (Maybe LType -> LType)
    -> (Type -> NamesT (TCMT IO) (Maybe LType))
    -> Type
    -> NamesT (TCMT IO) LType
    forall (m :: * -> *) b c a.
    Functor m =>
    (b -> c) -> (a -> m b) -> a -> m c
    <.> Type -> NamesT (TCMT IO) (Maybe LType)
    forall (m :: * -> *). MonadReduce m => Type -> m (Maybe LType)
    toLType (Type -> NamesT (TCMT IO) LType)
    -> NamesT (TCMT IO) Type -> NamesT (TCMT IO) LType
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< (NamesT (TCMT IO) (AbsN Type)
    dT NamesT (TCMT IO) (AbsN Type)
    -> [NamesT (TCMT IO) (SubstArg Type)] -> NamesT (TCMT IO) Type
    forall (m :: * -> *) a.
    (Monad m, Subst a) =>
    NamesT m (AbsN a) -> [NamesT m (SubstArg a)] -> NamesT m a
    `applyN` ([NamesT (TCMT IO) Term]
    delta [NamesT (TCMT IO) Term]
    -> [NamesT (TCMT IO) Term] -> [NamesT (TCMT IO) Term]
    forall a. [a] -> [a] -> [a]
    ++ [NamesT (TCMT IO) Term]
    x [NamesT (TCMT IO) Term]
    -> [NamesT (TCMT IO) Term] -> [NamesT (TCMT IO) Term]
    forall a. [a] -> [a] -> [a]
    ++ [Term -> NamesT (TCMT IO) Term
    forall a. a -> NamesT (TCMT IO) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Term
    iz]))
                let ds = (Term -> Arg (Named_ (Pattern' DBPatVar)))
    -> [Term] -> [Arg (Named_ (Pattern' DBPatVar))]
    forall a b. (a -> b) -> [a] -> [b]
    map (Named_ (Pattern' DBPatVar) -> Arg (Named_ (Pattern' DBPatVar))
    forall e. e -> Arg e
    argH (Named_ (Pattern' DBPatVar) -> Arg (Named_ (Pattern' DBPatVar)))
    -> (Term -> Named_ (Pattern' DBPatVar))
    -> Term
    -> Arg (Named_ (Pattern' DBPatVar))
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Pattern' DBPatVar -> Named_ (Pattern' DBPatVar)
    forall a name. a -> Named name a
    unnamed (Pattern' DBPatVar -> Named_ (Pattern' DBPatVar))
    -> (Term -> Pattern' DBPatVar)
    -> Term
    -> Named_ (Pattern' DBPatVar)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Term -> Pattern' DBPatVar
    forall a. Term -> Pattern' a
    dotP) [Level -> Term
    Level Level
    l, Term
    t]
                sequence as0 >>= \case
                  ps0 :: [Arg (Named_ (Pattern' DBPatVar))]
    ps0@[Arg (Named_ (Pattern' DBPatVar))
    _hphi,Arg (Named_ (Pattern' DBPatVar))
    _u,Arg (Named_ (Pattern' DBPatVar))
    _u0] ->
                    Pattern' DBPatVar -> NamesT (TCMT IO) (Pattern' DBPatVar)
    forall a. a -> NamesT (TCMT IO) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Pattern' DBPatVar -> NamesT (TCMT IO) (Pattern' DBPatVar))
    -> Pattern' DBPatVar -> NamesT (TCMT IO) (Pattern' DBPatVar)
    forall a b. (a -> b) -> a -> b
    $ PatternInfo
    -> QName -> [Arg (Named_ (Pattern' DBPatVar))] -> Pattern' DBPatVar
    forall x.
    PatternInfo -> QName -> [NamedArg (Pattern' x)] -> Pattern' x
    DefP PatternInfo
    defaultPatternInfo QName
    qHComp ([Arg (Named_ (Pattern' DBPatVar))] -> Pattern' DBPatVar)
    -> [Arg (Named_ (Pattern' DBPatVar))] -> Pattern' DBPatVar
    forall a b. (a -> b) -> a -> b
    $ [Arg (Named_ (Pattern' DBPatVar))]
    ds [Arg (Named_ (Pattern' DBPatVar))]
    -> [Arg (Named_ (Pattern' DBPatVar))]
    -> [Arg (Named_ (Pattern' DBPatVar))]
    forall a. [a] -> [a] -> [a]
    ++ [Arg (Named_ (Pattern' DBPatVar))]
    ps0
                  [Arg (Named_ (Pattern' DBPatVar))]
    _ -> NamesT (TCMT IO) (Pattern' DBPatVar)
    forall a. HasCallStack => a
    __IMPOSSIBLE__
              psHComp :: NamesT (TCMT IO) [Arg (Named_ (Pattern' DBPatVar))]
    psHComp = [NamesT (TCMT IO) (Arg (Named_ (Pattern' DBPatVar)))]
    -> NamesT (TCMT IO) [Arg (Named_ (Pattern' DBPatVar))]
    forall (t :: * -> *) (m :: * -> *) a.
    (Traversable t, Monad m) =>
    t (m a) -> m (t a)
    forall (m :: * -> *) a. Monad m => [m a] -> m [a]
    sequence ([NamesT (TCMT IO) (Arg (Named_ (Pattern' DBPatVar)))]
     -> NamesT (TCMT IO) [Arg (Named_ (Pattern' DBPatVar))])
    -> [NamesT (TCMT IO) (Arg (Named_ (Pattern' DBPatVar)))]
    -> NamesT (TCMT IO) [Arg (Named_ (Pattern' DBPatVar))]
    forall a b. (a -> b) -> a -> b
    $ [NamesT (TCMT IO) (Arg (Named_ (Pattern' DBPatVar)))]
    ArgVars (TCMT IO)
    delta_ps [NamesT (TCMT IO) (Arg (Named_ (Pattern' DBPatVar)))]
    -> [NamesT (TCMT IO) (Arg (Named_ (Pattern' DBPatVar)))]
    -> [NamesT (TCMT IO) (Arg (Named_ (Pattern' DBPatVar)))]
    forall a. [a] -> [a] -> [a]
    ++ [NamesT (TCMT IO) (Arg (Named_ (Pattern' DBPatVar)))]
    ArgVars (TCMT IO)
    x_ps [NamesT (TCMT IO) (Arg (Named_ (Pattern' DBPatVar)))]
    -> [NamesT (TCMT IO) (Arg (Named_ (Pattern' DBPatVar)))]
    -> [NamesT (TCMT IO) (Arg (Named_ (Pattern' DBPatVar)))]
    forall a. [a] -> [a] -> [a]
    ++ [NamesT (TCMT IO) (Arg (Named_ (Pattern' DBPatVar)))]
    ArgVars (TCMT IO)
    phi_ps [NamesT (TCMT IO) (Arg (Named_ (Pattern' DBPatVar)))]
    -> [NamesT (TCMT IO) (Arg (Named_ (Pattern' DBPatVar)))]
    -> [NamesT (TCMT IO) (Arg (Named_ (Pattern' DBPatVar)))]
    forall a. [a] -> [a] -> [a]
    ++ [Named_ (Pattern' DBPatVar) -> Arg (Named_ (Pattern' DBPatVar))
    forall e. e -> Arg e
    argN (Named_ (Pattern' DBPatVar) -> Arg (Named_ (Pattern' DBPatVar)))
    -> (Pattern' DBPatVar -> Named_ (Pattern' DBPatVar))
    -> Pattern' DBPatVar
    -> Arg (Named_ (Pattern' DBPatVar))
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Pattern' DBPatVar -> Named_ (Pattern' DBPatVar)
    forall a name. a -> Named name a
    unnamed (Pattern' DBPatVar -> Arg (Named_ (Pattern' DBPatVar)))
    -> NamesT (TCMT IO) (Pattern' DBPatVar)
    -> NamesT (TCMT IO) (Arg (Named_ (Pattern' DBPatVar)))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> NamesT (TCMT IO) (Pattern' DBPatVar)
    origPHComp]
            let
              rhsTy :: NamesT (TCMT IO) Type
    rhsTy = NamesT (TCMT IO) (AbsN Type)
    dT NamesT (TCMT IO) (AbsN Type)
    -> [NamesT (TCMT IO) (SubstArg Type)] -> NamesT (TCMT IO) Type
    forall (m :: * -> *) a.
    (Monad m, Subst a) =>
    NamesT m (AbsN a) -> [NamesT m (SubstArg a)] -> NamesT m a
    `applyN` ([NamesT (TCMT IO) Term]
    delta [NamesT (TCMT IO) Term]
    -> [NamesT (TCMT IO) Term] -> [NamesT (TCMT IO) Term]
    forall a. [a] -> [a] -> [a]
    ++ [NamesT (TCMT IO) Term]
    x [NamesT (TCMT IO) Term]
    -> [NamesT (TCMT IO) Term] -> [NamesT (TCMT IO) Term]
    forall a. [a] -> [a] -> [a]
    ++ [Term -> NamesT (TCMT IO) Term
    forall a. a -> NamesT (TCMT IO) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Term
    io])
            -- trD δ x φ (hcomp [hφ ↦ u] u0) ↦ rhsHComp
            let rhsHComp :: NamesT (TCMT IO) Term
    rhsHComp = do
                  let [NamesT (TCMT IO) Term
    hphi,NamesT (TCMT IO) Term
    u,NamesT (TCMT IO) Term
    u0] = (NamesT (TCMT IO) (Arg Term) -> NamesT (TCMT IO) Term)
    -> [NamesT (TCMT IO) (Arg Term)] -> [NamesT (TCMT IO) Term]
    forall a b. (a -> b) -> [a] -> [b]
    map ((Arg Term -> Term)
    -> NamesT (TCMT IO) (Arg Term) -> NamesT (TCMT IO) Term
    forall a b. (a -> b) -> NamesT (TCMT IO) a -> NamesT (TCMT IO) b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Arg Term -> Term
    forall e. Arg e -> e
    unArg) [NamesT (TCMT IO) (Arg Term)]
    ArgVars (TCMT IO)
    as0
                  -- TODO: should trD be transp for the datatype?
                  let baseHComp :: NamesT (TCMT IO) Term
    baseHComp = NamesT (TCMT IO) (AbsN (AbsN (AbsN Term)))
    trD NamesT (TCMT IO) (AbsN (AbsN (AbsN Term)))
    -> [NamesT (TCMT IO) (SubstArg (AbsN (AbsN Term)))]
    -> NamesT (TCMT IO) (AbsN (AbsN Term))
    forall (m :: * -> *) a.
    (Monad m, Subst a) =>
    NamesT m (AbsN a) -> [NamesT m (SubstArg a)] -> NamesT m a
    `applyN` [NamesT (TCMT IO) Term]
    [NamesT (TCMT IO) (SubstArg (AbsN (AbsN Term)))]
    delta NamesT (TCMT IO) (AbsN (AbsN Term))
    -> [NamesT (TCMT IO) (SubstArg (AbsN Term))]
    -> NamesT (TCMT IO) (AbsN Term)
    forall (m :: * -> *) a.
    (Monad m, Subst a) =>
    NamesT m (AbsN a) -> [NamesT m (SubstArg a)] -> NamesT m a
    `applyN` [NamesT (TCMT IO) Term]
    [NamesT (TCMT IO) (SubstArg (AbsN Term))]
    x NamesT (TCMT IO) (AbsN Term)
    -> [NamesT (TCMT IO) (SubstArg Term)] -> NamesT (TCMT IO) Term
    forall (m :: * -> *) a.
    (Monad m, Subst a) =>
    NamesT m (AbsN a) -> [NamesT m (SubstArg a)] -> NamesT m a
    `applyN` [NamesT (TCMT IO) Term
    NamesT (TCMT IO) (SubstArg Term)
    phi,NamesT (TCMT IO) Term
    NamesT (TCMT IO) (SubstArg Term)
    u0]
                  let sideHComp :: NamesT (TCMT IO) Term
    sideHComp = String
    -> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
    -> NamesT (TCMT IO) Term
    forall (m :: * -> *).
    Monad m =>
    String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
    lam String
    "i" ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
     -> NamesT (TCMT IO) Term)
    -> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
    -> NamesT (TCMT IO) Term
    forall a b. (a -> b) -> a -> b
    $ \ NamesT (TCMT IO) Term
    i -> String
    -> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
    -> NamesT (TCMT IO) Term
    forall (m :: * -> *).
    Monad m =>
    String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
    ilam String
    "o" ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
     -> NamesT (TCMT IO) Term)
    -> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
    -> NamesT (TCMT IO) Term
    forall a b. (a -> b) -> a -> b
    $ \ NamesT (TCMT IO) Term
    o -> do
                         NamesT (TCMT IO) (AbsN (AbsN (AbsN Term)))
    trD NamesT (TCMT IO) (AbsN (AbsN (AbsN Term)))
    -> [NamesT (TCMT IO) (SubstArg (AbsN (AbsN Term)))]
    -> NamesT (TCMT IO) (AbsN (AbsN Term))
    forall (m :: * -> *) a.
    (Monad m, Subst a) =>
    NamesT m (AbsN a) -> [NamesT m (SubstArg a)] -> NamesT m a
    `applyN` [NamesT (TCMT IO) Term]
    [NamesT (TCMT IO) (SubstArg (AbsN (AbsN Term)))]
    delta NamesT (TCMT IO) (AbsN (AbsN Term))
    -> [NamesT (TCMT IO) (SubstArg (AbsN Term))]
    -> NamesT (TCMT IO) (AbsN Term)
    forall (m :: * -> *) a.
    (Monad m, Subst a) =>
    NamesT m (AbsN a) -> [NamesT m (SubstArg a)] -> NamesT m a
    `applyN` [NamesT (TCMT IO) Term]
    [NamesT (TCMT IO) (SubstArg (AbsN Term))]
    x NamesT (TCMT IO) (AbsN Term)
    -> [NamesT (TCMT IO) (SubstArg Term)] -> NamesT (TCMT IO) Term
    forall (m :: * -> *) a.
    (Monad m, Subst a) =>
    NamesT m (AbsN a) -> [NamesT m (SubstArg a)] -> NamesT m a
    `applyN` [NamesT (TCMT IO) Term
    NamesT (TCMT IO) (SubstArg Term)
    phi,NamesT (TCMT IO) Term
    u NamesT (TCMT IO) Term
    -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <@> NamesT (TCMT IO) Term
    i NamesT (TCMT IO) Term
    -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <..> NamesT (TCMT IO) Term
    o]
                  NamesT (TCMT IO) Type
    -> [(NamesT (TCMT IO) Term, NamesT (TCMT IO) Term)]
    -> NamesT (TCMT IO) Term
    -> NamesT (TCMT IO) Term
    hcomp NamesT (TCMT IO) Type
    rhsTy [(NamesT (TCMT IO) Term
    hphi, NamesT (TCMT IO) Term
    sideHComp)] NamesT (TCMT IO) Term
    baseHComp
            (,,) ([Arg (Named_ (Pattern' DBPatVar))]
     -> Type
     -> Term
     -> ([Arg (Named_ (Pattern' DBPatVar))], Type, Term))
    -> NamesT (TCMT IO) [Arg (Named_ (Pattern' DBPatVar))]
    -> NamesT
         (TCMT IO)
         (Type -> Term -> ([Arg (Named_ (Pattern' DBPatVar))], Type, Term))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> NamesT (TCMT IO) [Arg (Named_ (Pattern' DBPatVar))]
    psHComp NamesT
      (TCMT IO)
      (Type -> Term -> ([Arg (Named_ (Pattern' DBPatVar))], Type, Term))
    -> NamesT (TCMT IO) Type
    -> NamesT
         (TCMT IO)
         (Term -> ([Arg (Named_ (Pattern' DBPatVar))], Type, Term))
    forall a b.
    NamesT (TCMT IO) (a -> b)
    -> NamesT (TCMT IO) a -> NamesT (TCMT IO) b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> NamesT (TCMT IO) Type
    rhsTy NamesT
      (TCMT IO)
      (Term -> ([Arg (Named_ (Pattern' DBPatVar))], Type, Term))
    -> NamesT (TCMT IO) Term
    -> NamesT
         (TCMT IO) ([Arg (Named_ (Pattern' DBPatVar))], Type, Term)
    forall a b.
    NamesT (TCMT IO) (a -> b)
    -> NamesT (TCMT IO) a -> NamesT (TCMT IO) b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> NamesT (TCMT IO) Term
    rhsHComp
          let (ps,rhsTy,rhs) = unAbsN $ unAbsN $ unAbsN $ unAbsN $ res
          (:[]) <$> mkClause gamma ps rhsTy rhs

      c_trX   <- caseMaybe mtrX (pure []) $ \ QName
    trX -> do
            String -> Nat -> TCMT IO Doc -> TCM ()
    forall (m :: * -> *).
    MonadDebug m =>
    String -> Nat -> TCMT IO Doc -> m ()
    reportSDoc String
    "tc.data.transp.con" Nat
    20 (TCMT IO Doc -> TCM ()) -> TCMT IO Doc -> TCM ()
    forall a b. (a -> b) -> a -> b
    $ TCMT IO Doc
    "======================="
            String -> Nat -> TCMT IO Doc -> TCM ()
    forall (m :: * -> *).
    MonadDebug m =>
    String -> Nat -> TCMT IO Doc -> m ()
    reportSDoc String
    "tc.data.transp.con" Nat
    20 (TCMT IO Doc -> TCM ()) -> TCMT IO Doc -> TCM ()
    forall a b. (a -> b) -> a -> b
    $ QName -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    forall (m :: * -> *). MonadPretty m => QName -> m Doc
    prettyTCM QName
    trX
            gamma <- Names
    -> NamesT (TCMT IO) (Tele (Dom Type)) -> TCMT IO (Tele (Dom Type))
    forall (m :: * -> *) a. Names -> NamesT m a -> m a
    runNamesT [] (NamesT (TCMT IO) (Tele (Dom Type)) -> TCMT IO (Tele (Dom Type)))
    -> NamesT (TCMT IO) (Tele (Dom Type)) -> TCMT IO (Tele (Dom Type))
    forall a b. (a -> b) -> a -> b
    $ do
                         ixsI <- AbsN (Tele (Dom Type))
    -> NamesT (TCMT IO) (NamesT (TCMT IO) (AbsN (Tele (Dom Type))))
    forall (m :: * -> *) a.
    (Monad m, Subst a) =>
    a -> NamesT m (NamesT m a)
    open (AbsN (Tele (Dom Type))
     -> NamesT (TCMT IO) (NamesT (TCMT IO) (AbsN (Tele (Dom Type)))))
    -> AbsN (Tele (Dom Type))
    -> NamesT (TCMT IO) (NamesT (TCMT IO) (AbsN (Tele (Dom Type))))
    forall a b. (a -> b) -> a -> b
    $ Names -> Tele (Dom Type) -> AbsN (Tele (Dom Type))
    forall a. Names -> a -> AbsN a
    AbsN (Tele (Dom Type) -> Names
    teleNames Tele (Dom Type)
    parI) Tele (Dom Type)
    ixsI
                         parI <- open parI
                         abstract_trD $ \ Vars (TCMT IO)
    delta Vars (TCMT IO)
    _ Vars (TCMT IO)
    _ -> do
                         let delta0_refl :: [NamesT (TCMT IO) Term]
    delta0_refl = [NamesT (TCMT IO) Term]
    -> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
    -> [NamesT (TCMT IO) Term]
    forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
    for [NamesT (TCMT IO) Term]
    Vars (TCMT IO)
    delta ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
     -> [NamesT (TCMT IO) Term])
    -> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
    -> [NamesT (TCMT IO) Term]
    forall a b. (a -> b) -> a -> b
    $ \ NamesT (TCMT IO) Term
    p -> String
    -> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
    -> NamesT (TCMT IO) Term
    forall (m :: * -> *).
    Monad m =>
    String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
    lam String
    "i" ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
     -> NamesT (TCMT IO) Term)
    -> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
    -> NamesT (TCMT IO) Term
    forall a b. (a -> b) -> a -> b
    $ \ NamesT (TCMT IO) Term
    _ -> NamesT (TCMT IO) Term
    p NamesT (TCMT IO) Term
    -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <@> Term -> NamesT (TCMT IO) Term
    forall a. a -> NamesT (TCMT IO) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Term
    iz
                         NamesT (TCMT IO) (Tele (Dom Type))
    -> (Vars (TCMT IO) -> NamesT (TCMT IO) (Tele (Dom Type)))
    -> NamesT (TCMT IO) (Tele (Dom Type))
    forall (m :: * -> *) a.
    (Monad m, Abstract a) =>
    NamesT m (Tele (Dom Type)) -> (Vars m -> NamesT m a) -> NamesT m a
    abstractN (NamesT (TCMT IO) (AbsN (Tele (Dom Type)))
    ixsI NamesT (TCMT IO) (AbsN (Tele (Dom Type)))
    -> [NamesT (TCMT IO) (SubstArg (Tele (Dom Type)))]
    -> NamesT (TCMT IO) (Tele (Dom Type))
    forall (m :: * -> *) a.
    (Monad m, Subst a) =>
    NamesT m (AbsN a) -> [NamesT m (SubstArg a)] -> NamesT m a
    `applyN` [NamesT (TCMT IO) Term]
    [NamesT (TCMT IO) (SubstArg (Tele (Dom Type)))]
    delta0_refl) ((Vars (TCMT IO) -> NamesT (TCMT IO) (Tele (Dom Type)))
     -> NamesT (TCMT IO) (Tele (Dom Type)))
    -> (Vars (TCMT IO) -> NamesT (TCMT IO) (Tele (Dom Type)))
    -> NamesT (TCMT IO) (Tele (Dom Type))
    forall a b. (a -> b) -> a -> b
    $ \ Vars (TCMT IO)
    x' -> do
                         NamesT (TCMT IO) (Tele (Dom Type))
    -> (Vars (TCMT IO) -> NamesT (TCMT IO) (Tele (Dom Type)))
    -> NamesT (TCMT IO) (Tele (Dom Type))
    forall (m :: * -> *) a.
    (Monad m, Abstract a) =>
    NamesT m (Tele (Dom Type)) -> (Vars m -> NamesT m a) -> NamesT m a
    abstractN (Tele (Dom Type) -> NamesT (TCMT IO) (Tele (Dom Type))
    forall a. a -> NamesT (TCMT IO) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Tele (Dom Type) -> NamesT (TCMT IO) (Tele (Dom Type)))
    -> Tele (Dom Type) -> NamesT (TCMT IO) (Tele (Dom Type))
    forall a b. (a -> b) -> a -> b
    $ String -> Tele (Dom Type)
    intervalTel String
    "phi'") ((Vars (TCMT IO) -> NamesT (TCMT IO) (Tele (Dom Type)))
     -> NamesT (TCMT IO) (Tele (Dom Type)))
    -> (Vars (TCMT IO) -> NamesT (TCMT IO) (Tele (Dom Type)))
    -> NamesT (TCMT IO) (Tele (Dom Type))
    forall a b. (a -> b) -> a -> b
    $ \ Vars (TCMT IO)
    _ -> do
                         ty <- NamesT (TCMT IO) (AbsN Type)
    dT NamesT (TCMT IO) (AbsN Type)
    -> [NamesT (TCMT IO) (SubstArg Type)] -> NamesT (TCMT IO) Type
    forall (m :: * -> *) a.
    (Monad m, Subst a) =>
    NamesT m (AbsN a) -> [NamesT m (SubstArg a)] -> NamesT m a
    `applyN` ([NamesT (TCMT IO) Term]
    delta0_refl [NamesT (TCMT IO) Term]
    -> [NamesT (TCMT IO) Term] -> [NamesT (TCMT IO) Term]
    forall a. [a] -> [a] -> [a]
    ++ [NamesT (TCMT IO) Term]
    Vars (TCMT IO)
    x' [NamesT (TCMT IO) Term]
    -> [NamesT (TCMT IO) Term] -> [NamesT (TCMT IO) Term]
    forall a. [a] -> [a] -> [a]
    ++ [Term -> NamesT (TCMT IO) Term
    forall a. a -> NamesT (TCMT IO) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Term
    iz])
                         pure $ ExtendTel (defaultDom ty) $ Abs "t" EmptyTel
            res <- runNamesT [] $
              bind_trD $ \ ArgVars (TCMT IO)
    delta_ps ArgVars (TCMT IO)
    x_ps ArgVars (TCMT IO)
    phi_ps -> do
              let x :: [NamesT (TCMT IO) Term]
    x = (NamesT (TCMT IO) (Arg Term) -> NamesT (TCMT IO) Term)
    -> [NamesT (TCMT IO) (Arg Term)] -> [NamesT (TCMT IO) Term]
    forall a b. (a -> b) -> [a] -> [b]
    map ((Arg Term -> Term)
    -> NamesT (TCMT IO) (Arg Term) -> NamesT (TCMT IO) Term
    forall a b. (a -> b) -> NamesT (TCMT IO) a -> NamesT (TCMT IO) b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Arg Term -> Term
    forall e. Arg e -> e
    unArg) [NamesT (TCMT IO) (Arg Term)]
    ArgVars (TCMT IO)
    x_ps
              let delta :: [NamesT (TCMT IO) Term]
    delta = (NamesT (TCMT IO) (Arg Term) -> NamesT (TCMT IO) Term)
    -> [NamesT (TCMT IO) (Arg Term)] -> [NamesT (TCMT IO) Term]
    forall a b. (a -> b) -> [a] -> [b]
    map ((Arg Term -> Term)
    -> NamesT (TCMT IO) (Arg Term) -> NamesT (TCMT IO) Term
    forall a b. (a -> b) -> NamesT (TCMT IO) a -> NamesT (TCMT IO) b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Arg Term -> Term
    forall e. Arg e -> e
    unArg) [NamesT (TCMT IO) (Arg Term)]
    ArgVars (TCMT IO)
    delta_ps
              let [NamesT (TCMT IO) Term
    phi] = (NamesT (TCMT IO) (Arg Term) -> NamesT (TCMT IO) Term)
    -> [NamesT (TCMT IO) (Arg Term)] -> [NamesT (TCMT IO) Term]
    forall a b. (a -> b) -> [a] -> [b]
    map ((Arg Term -> Term)
    -> NamesT (TCMT IO) (Arg Term) -> NamesT (TCMT IO) Term
    forall a b. (a -> b) -> NamesT (TCMT IO) a -> NamesT (TCMT IO) b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Arg Term -> Term
    forall e. Arg e -> e
    unArg) [NamesT (TCMT IO) (Arg Term)]
    ArgVars (TCMT IO)
    phi_ps
              --- pattern matching args below
              [Arg String]
    -> (ArgVars (TCMT IO)
        -> NamesT
             (TCMT IO)
             (AbsN (AbsN ([Arg (Named_ (Pattern' DBPatVar))], Type, Term))))
    -> NamesT
         (TCMT IO)
         (AbsN
            (AbsN (AbsN ([Arg (Named_ (Pattern' DBPatVar))], Type, Term))))
    forall (m :: * -> *) a.
    Monad m =>
    [Arg String] -> (ArgVars m -> NamesT m a) -> NamesT m (AbsN a)
    bindNArg ((Arg String -> Arg String) -> [Arg String] -> [Arg String]
    forall a b. (a -> b) -> [a] -> [b]
    map ((String -> String) -> Arg String -> Arg String
    forall a b. (a -> b) -> Arg a -> Arg b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "'")) (Tele (Dom Type) -> [Arg String]
    teleArgNames Tele (Dom Type)
    ixsI)) ((ArgVars (TCMT IO)
      -> NamesT
           (TCMT IO)
           (AbsN (AbsN ([Arg (Named_ (Pattern' DBPatVar))], Type, Term))))
     -> NamesT
          (TCMT IO)
          (AbsN
             (AbsN (AbsN ([Arg (Named_ (Pattern' DBPatVar))], Type, Term)))))
    -> (ArgVars (TCMT IO)
        -> NamesT
             (TCMT IO)
             (AbsN (AbsN ([Arg (Named_ (Pattern' DBPatVar))], Type, Term))))
    -> NamesT
         (TCMT IO)
         (AbsN
            (AbsN (AbsN ([Arg (Named_ (Pattern' DBPatVar))], Type, Term))))
    forall a b. (a -> b) -> a -> b
    $ \ ArgVars (TCMT IO)
    x'_ps -> do
              let x' :: [NamesT (TCMT IO) Term]
    x' = (NamesT (TCMT IO) (Arg Term) -> NamesT (TCMT IO) Term)
    -> [NamesT (TCMT IO) (Arg Term)] -> [NamesT (TCMT IO) Term]
    forall a b. (a -> b) -> [a] -> [b]
    map ((Arg Term -> Term)
    -> NamesT (TCMT IO) (Arg Term) -> NamesT (TCMT IO) Term
    forall a b. (a -> b) -> NamesT (TCMT IO) a -> NamesT (TCMT IO) b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Arg Term -> Term
    forall e. Arg e -> e
    unArg) [NamesT (TCMT IO) (Arg Term)]
    ArgVars (TCMT IO)
    x'_ps :: [NamesT TCM Term]
              let phi'name :: [Arg String]
    phi'name = Tele (Dom Type) -> [Arg String]
    teleArgNames (Tele (Dom Type) -> [Arg String])
    -> Tele (Dom Type) -> [Arg String]
    forall a b. (a -> b) -> a -> b
    $ String -> Tele (Dom Type)
    intervalTel String
    "phi'"
              [Arg String]
    -> (ArgVars (TCMT IO)
        -> NamesT
             (TCMT IO) (AbsN ([Arg (Named_ (Pattern' DBPatVar))], Type, Term)))
    -> NamesT
         (TCMT IO)
         (AbsN (AbsN ([Arg (Named_ (Pattern' DBPatVar))], Type, Term)))
    forall (m :: * -> *) a.
    Monad m =>
    [Arg String] -> (ArgVars m -> NamesT m a) -> NamesT m (AbsN a)
    bindNArg [Arg String]
    phi'name ((ArgVars (TCMT IO)
      -> NamesT
           (TCMT IO) (AbsN ([Arg (Named_ (Pattern' DBPatVar))], Type, Term)))
     -> NamesT
          (TCMT IO)
          (AbsN (AbsN ([Arg (Named_ (Pattern' DBPatVar))], Type, Term))))
    -> (ArgVars (TCMT IO)
        -> NamesT
             (TCMT IO) (AbsN ([Arg (Named_ (Pattern' DBPatVar))], Type, Term)))
    -> NamesT
         (TCMT IO)
         (AbsN (AbsN ([Arg (Named_ (Pattern' DBPatVar))], Type, Term)))
    forall a b. (a -> b) -> a -> b
    $ \ ArgVars (TCMT IO)
    phi'_ps -> do
              let phi's :: [NamesT (TCMT IO) Term]
    phi's = (NamesT (TCMT IO) (Arg Term) -> NamesT (TCMT IO) Term)
    -> [NamesT (TCMT IO) (Arg Term)] -> [NamesT (TCMT IO) Term]
    forall a b. (a -> b) -> [a] -> [b]
    map ((Arg Term -> Term)
    -> NamesT (TCMT IO) (Arg Term) -> NamesT (TCMT IO) Term
    forall a b. (a -> b) -> NamesT (TCMT IO) a -> NamesT (TCMT IO) b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Arg Term -> Term
    forall e. Arg e -> e
    unArg) [NamesT (TCMT IO) (Arg Term)]
    ArgVars (TCMT IO)
    phi'_ps
              [Arg String]
    -> (ArgVars (TCMT IO)
        -> NamesT
             (TCMT IO) ([Arg (Named_ (Pattern' DBPatVar))], Type, Term))
    -> NamesT
         (TCMT IO) (AbsN ([Arg (Named_ (Pattern' DBPatVar))], Type, Term))
    forall (m :: * -> *) a.
    Monad m =>
    [Arg String] -> (ArgVars m -> NamesT m a) -> NamesT m (AbsN a)
    bindNArg [String -> Arg String
    forall e. e -> Arg e
    argN String
    "t"] ((ArgVars (TCMT IO)
      -> NamesT
           (TCMT IO) ([Arg (Named_ (Pattern' DBPatVar))], Type, Term))
     -> NamesT
          (TCMT IO) (AbsN ([Arg (Named_ (Pattern' DBPatVar))], Type, Term)))
    -> (ArgVars (TCMT IO)
        -> NamesT
             (TCMT IO) ([Arg (Named_ (Pattern' DBPatVar))], Type, Term))
    -> NamesT
         (TCMT IO) (AbsN ([Arg (Named_ (Pattern' DBPatVar))], Type, Term))
    forall a b. (a -> b) -> a -> b
    $ \ ArgVars (TCMT IO)
    as0 -> do
              let deltaArg :: NamesT (TCMT IO) Term -> NamesT (TCMT IO) [Arg Term]
    deltaArg NamesT (TCMT IO) Term
    i = do
                    i <- NamesT (TCMT IO) Term
    i
                    xs <- sequence delta_ps
                    pure $ map (fmap (`apply` [argN i])) xs

              let
                origPTrX :: NamesT (TCMT IO) (Pattern' DBPatVar)
    origPTrX = do
                  x'_ps <- [NamesT (TCMT IO) (Arg (Named_ (Pattern' DBPatVar)))]
    -> NamesT (TCMT IO) [Arg (Named_ (Pattern' DBPatVar))]
    forall (t :: * -> *) (m :: * -> *) a.
    (Traversable t, Monad m) =>
    t (m a) -> m (t a)
    forall (m :: * -> *) a. Monad m => [m a] -> m [a]
    sequence [NamesT (TCMT IO) (Arg (Named_ (Pattern' DBPatVar)))]
    ArgVars (TCMT IO)
    x'_ps
                  phi'_ps <- sequence phi'_ps
                  ds <- map (setHiding Hidden . fmap (unnamed . dotP)) <$> deltaArg (pure iz)
                  ps0 <- sequence as0
                  unless (length ps0 == 1) __IMPOSSIBLE__
                  pure $ DefP defaultPatternInfo trX $ ds ++ x'_ps ++ phi'_ps ++ ps0
                psTrX :: NamesT (TCMT IO) [Arg (Named_ (Pattern' DBPatVar))]
    psTrX = [NamesT (TCMT IO) (Arg (Named_ (Pattern' DBPatVar)))]
    -> NamesT (TCMT IO) [Arg (Named_ (Pattern' DBPatVar))]
    forall (t :: * -> *) (m :: * -> *) a.
    (Traversable t, Monad m) =>
    t (m a) -> m (t a)
    forall (m :: * -> *) a. Monad m => [m a] -> m [a]
    sequence ([NamesT (TCMT IO) (Arg (Named_ (Pattern' DBPatVar)))]
     -> NamesT (TCMT IO) [Arg (Named_ (Pattern' DBPatVar))])
    -> [NamesT (TCMT IO) (Arg (Named_ (Pattern' DBPatVar)))]
    -> NamesT (TCMT IO) [Arg (Named_ (Pattern' DBPatVar))]
    forall a b. (a -> b) -> a -> b
    $ [NamesT (TCMT IO) (Arg (Named_ (Pattern' DBPatVar)))]
    ArgVars (TCMT IO)
    delta_ps [NamesT (TCMT IO) (Arg (Named_ (Pattern' DBPatVar)))]
    -> [NamesT (TCMT IO) (Arg (Named_ (Pattern' DBPatVar)))]
    -> [NamesT (TCMT IO) (Arg (Named_ (Pattern' DBPatVar)))]
    forall a. [a] -> [a] -> [a]
    ++ [NamesT (TCMT IO) (Arg (Named_ (Pattern' DBPatVar)))]
    ArgVars (TCMT IO)
    x_ps [NamesT (TCMT IO) (Arg (Named_ (Pattern' DBPatVar)))]
    -> [NamesT (TCMT IO) (Arg (Named_ (Pattern' DBPatVar)))]
    -> [NamesT (TCMT IO) (Arg (Named_ (Pattern' DBPatVar)))]
    forall a. [a] -> [a] -> [a]
    ++ [NamesT (TCMT IO) (Arg (Named_ (Pattern' DBPatVar)))]
    ArgVars (TCMT IO)
    phi_ps [NamesT (TCMT IO) (Arg (Named_ (Pattern' DBPatVar)))]
    -> [NamesT (TCMT IO) (Arg (Named_ (Pattern' DBPatVar)))]
    -> [NamesT (TCMT IO) (Arg (Named_ (Pattern' DBPatVar)))]
    forall a. [a] -> [a] -> [a]
    ++ [Named_ (Pattern' DBPatVar) -> Arg (Named_ (Pattern' DBPatVar))
    forall e. e -> Arg e
    argN (Named_ (Pattern' DBPatVar) -> Arg (Named_ (Pattern' DBPatVar)))
    -> (Pattern' DBPatVar -> Named_ (Pattern' DBPatVar))
    -> Pattern' DBPatVar
    -> Arg (Named_ (Pattern' DBPatVar))
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Pattern' DBPatVar -> Named_ (Pattern' DBPatVar)
    forall a name. a -> Named name a
    unnamed (Pattern' DBPatVar -> Arg (Named_ (Pattern' DBPatVar)))
    -> NamesT (TCMT IO) (Pattern' DBPatVar)
    -> NamesT (TCMT IO) (Arg (Named_ (Pattern' DBPatVar)))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> NamesT (TCMT IO) (Pattern' DBPatVar)
    origPTrX]

                rhsTy :: NamesT (TCMT IO) Type
    rhsTy = NamesT (TCMT IO) (AbsN Type)
    dT NamesT (TCMT IO) (AbsN Type)
    -> [NamesT (TCMT IO) (SubstArg Type)] -> NamesT (TCMT IO) Type
    forall (m :: * -> *) a.
    (Monad m, Subst a) =>
    NamesT m (AbsN a) -> [NamesT m (SubstArg a)] -> NamesT m a
    `applyN` ([NamesT (TCMT IO) Term]
    delta [NamesT (TCMT IO) Term]
    -> [NamesT (TCMT IO) Term] -> [NamesT (TCMT IO) Term]
    forall a. [a] -> [a] -> [a]
    ++ [NamesT (TCMT IO) Term]
    x [NamesT (TCMT IO) Term]
    -> [NamesT (TCMT IO) Term] -> [NamesT (TCMT IO) Term]
    forall a. [a] -> [a] -> [a]
    ++ [Term -> NamesT (TCMT IO) Term
    forall a. a -> NamesT (TCMT IO) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Term
    io])

              -- trD δ x φ (trX x' φ' t) ↦ rhsTrx
              let rhsTrX :: NamesT (TCMT IO) Term
    rhsTrX = do
                    let [NamesT (TCMT IO) Term
    t] = (NamesT (TCMT IO) (Arg Term) -> NamesT (TCMT IO) Term)
    -> [NamesT (TCMT IO) (Arg Term)] -> [NamesT (TCMT IO) Term]
    forall a b. (a -> b) -> [a] -> [b]
    map ((Arg Term -> Term)
    -> NamesT (TCMT IO) (Arg Term) -> NamesT (TCMT IO) Term
    forall a b. (a -> b) -> NamesT (TCMT IO) a -> NamesT (TCMT IO) b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Arg Term -> Term
    forall e. Arg e -> e
    unArg) [NamesT (TCMT IO) (Arg Term)]
    ArgVars (TCMT IO)
    as0
                    let [NamesT (TCMT IO) Term
    phi'] = [NamesT (TCMT IO) Term]
    phi's
                    let telXdeltai :: NamesT (TCMT IO) (Abs (Tele (Dom Type)))
    telXdeltai = String
    -> ((forall b. (Subst b, DeBruijn b) => NamesT (TCMT IO) b)
        -> NamesT (TCMT IO) (Tele (Dom Type)))
    -> NamesT (TCMT IO) (Abs (Tele (Dom Type)))
    forall (m :: * -> *) a.
    Monad m =>
    String
    -> ((forall b. (Subst b, DeBruijn b) => NamesT m b) -> NamesT m a)
    -> NamesT m (Abs a)
    bind String
    "i" (((forall b. (Subst b, DeBruijn b) => NamesT (TCMT IO) b)
      -> NamesT (TCMT IO) (Tele (Dom Type)))
     -> NamesT (TCMT IO) (Abs (Tele (Dom Type))))
    -> ((forall b. (Subst b, DeBruijn b) => NamesT (TCMT IO) b)
        -> NamesT (TCMT IO) (Tele (Dom Type)))
    -> NamesT (TCMT IO) (Abs (Tele (Dom Type)))
    forall a b. (a -> b) -> a -> b
    $ \ forall b. (Subst b, DeBruijn b) => NamesT (TCMT IO) b
    i -> NamesT (TCMT IO) (AbsN (Tele (Dom Type)))
    -> [NamesT (TCMT IO) (SubstArg (Tele (Dom Type)))]
    -> NamesT (TCMT IO) (Tele (Dom Type))
    forall (m :: * -> *) a.
    (Monad m, Subst a) =>
    NamesT m (AbsN a) -> [NamesT m (SubstArg a)] -> NamesT m a
    applyN NamesT (TCMT IO) (AbsN (Tele (Dom Type)))
    xTel ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
    -> [NamesT (TCMT IO) Term] -> [NamesT (TCMT IO) Term]
    forall a b. (a -> b) -> [a] -> [b]
    map (NamesT (TCMT IO) Term
    -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <@> NamesT (TCMT IO) Term
    forall b. (Subst b, DeBruijn b) => NamesT (TCMT IO) b
    i) [NamesT (TCMT IO) Term]
    delta)
                    let reflx1 :: [NamesT (TCMT IO) Term]
    reflx1 = [NamesT (TCMT IO) Term]
    -> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
    -> [NamesT (TCMT IO) Term]
    forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
    for [NamesT (TCMT IO) Term]
    x ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
     -> [NamesT (TCMT IO) Term])
    -> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
    -> [NamesT (TCMT IO) Term]
    forall a b. (a -> b) -> a -> b
    $ \ NamesT (TCMT IO) Term
    q -> String
    -> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
    -> NamesT (TCMT IO) Term
    forall (m :: * -> *).
    Monad m =>
    String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
    lam String
    "i" ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
     -> NamesT (TCMT IO) Term)
    -> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
    -> NamesT (TCMT IO) Term
    forall a b. (a -> b) -> a -> b
    $ \ NamesT (TCMT IO) Term
    _ -> NamesT (TCMT IO) Term
    q NamesT (TCMT IO) Term
    -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <@> Term -> NamesT (TCMT IO) Term
    forall a. a -> NamesT (TCMT IO) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Term
    io
                    let symx' :: [NamesT (TCMT IO) Term]
    symx' = [NamesT (TCMT IO) Term]
    -> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
    -> [NamesT (TCMT IO) Term]
    forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
    for [NamesT (TCMT IO) Term]
    x' ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
     -> [NamesT (TCMT IO) Term])
    -> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
    -> [NamesT (TCMT IO) Term]
    forall a b. (a -> b) -> a -> b
    $ \ NamesT (TCMT IO) Term
    q' -> String
    -> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
    -> NamesT (TCMT IO) Term
    forall (m :: * -> *).
    Monad m =>
    String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
    lam String
    "i" ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
     -> NamesT (TCMT IO) Term)
    -> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
    -> NamesT (TCMT IO) Term
    forall a b. (a -> b) -> a -> b
    $ \ NamesT (TCMT IO) Term
    i -> NamesT (TCMT IO) Term
    q' NamesT (TCMT IO) Term
    -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <@> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
    forall {m :: * -> *}.
    (HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
    NamesT m Term -> NamesT m Term
    neg NamesT (TCMT IO) Term
    i
                    x_tr <- (Arg Term -> NamesT (TCMT IO) (NamesT (TCMT IO) Term))
    -> [Arg Term] -> NamesT (TCMT IO) [NamesT (TCMT IO) Term]
    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 (Term -> NamesT (TCMT IO) (NamesT (TCMT IO) Term)
    forall (m :: * -> *) a.
    (Monad m, Subst a) =>
    a -> NamesT m (NamesT m a)
    open (Term -> NamesT (TCMT IO) (NamesT (TCMT IO) Term))
    -> (Arg Term -> Term)
    -> Arg Term
    -> NamesT (TCMT IO) (NamesT (TCMT IO) Term)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Arg Term -> Term
    forall e. Arg e -> e
    unArg) ([Arg Term] -> NamesT (TCMT IO) [NamesT (TCMT IO) Term])
    -> NamesT (TCMT IO) [Arg Term]
    -> NamesT (TCMT IO) [NamesT (TCMT IO) Term]
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< NamesT (TCMT IO) (Abs (Tele (Dom Type)))
    -> [NamesT (TCMT IO) Term]
    -> [NamesT (TCMT IO) Term]
    -> NamesT (TCMT IO) Term
    -> [NamesT (TCMT IO) Term]
    -> NamesT (TCMT IO) [Arg Term]
    transpPathTel' NamesT (TCMT IO) (Abs (Tele (Dom Type)))
    telXdeltai [NamesT (TCMT IO) Term]
    symx' [NamesT (TCMT IO) Term]
    reflx1 NamesT (TCMT IO) Term
    phi' [NamesT (TCMT IO) Term]
    x
                    let baseTrX = NamesT (TCMT IO) (AbsN (AbsN (AbsN Term)))
    trD NamesT (TCMT IO) (AbsN (AbsN (AbsN Term)))
    -> [NamesT (TCMT IO) (SubstArg (AbsN (AbsN Term)))]
    -> NamesT (TCMT IO) (AbsN (AbsN Term))
    forall (m :: * -> *) a.
    (Monad m, Subst a) =>
    NamesT m (AbsN a) -> [NamesT m (SubstArg a)] -> NamesT m a
    `applyN` [NamesT (TCMT IO) Term]
    [NamesT (TCMT IO) (SubstArg (AbsN (AbsN Term)))]
    delta NamesT (TCMT IO) (AbsN (AbsN Term))
    -> [NamesT (TCMT IO) (SubstArg (AbsN Term))]
    -> NamesT (TCMT IO) (AbsN Term)
    forall (m :: * -> *) a.
    (Monad m, Subst a) =>
    NamesT m (AbsN a) -> [NamesT m (SubstArg a)] -> NamesT m a
    `applyN` [NamesT (TCMT IO) Term]
    [NamesT (TCMT IO) (SubstArg (AbsN Term))]
    x_tr NamesT (TCMT IO) (AbsN Term)
    -> [NamesT (TCMT IO) (SubstArg Term)] -> NamesT (TCMT IO) Term
    forall (m :: * -> *) a.
    (Monad m, Subst a) =>
    NamesT m (AbsN a) -> [NamesT m (SubstArg a)] -> NamesT m a
    `applyN` [NamesT (TCMT IO) Term
    phi NamesT (TCMT IO) Term
    -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
    forall {m :: * -> *}.
    (HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
    NamesT m Term -> NamesT m Term -> NamesT m Term
    `min` NamesT (TCMT IO) Term
    phi',NamesT (TCMT IO) Term
    NamesT (TCMT IO) (SubstArg Term)
    t]
                    let sideTrX = String
    -> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
    -> NamesT (TCMT IO) Term
    forall (m :: * -> *).
    Monad m =>
    String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
    lam String
    "j" ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
     -> NamesT (TCMT IO) Term)
    -> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
    -> NamesT (TCMT IO) Term
    forall a b. (a -> b) -> a -> b
    $ \ NamesT (TCMT IO) Term
    j -> String
    -> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
    -> NamesT (TCMT IO) Term
    forall (m :: * -> *).
    Monad m =>
    String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
    ilam String
    "o" ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
     -> NamesT (TCMT IO) Term)
    -> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
    -> NamesT (TCMT IO) Term
    forall a b. (a -> b) -> a -> b
    $ \ NamesT (TCMT IO) Term
    _ -> do
                          let trD_f :: NamesT (TCMT IO) Term
    trD_f = NamesT (TCMT IO) (AbsN (AbsN (AbsN Term)))
    trD NamesT (TCMT IO) (AbsN (AbsN (AbsN Term)))
    -> [NamesT (TCMT IO) (SubstArg (AbsN (AbsN Term)))]
    -> NamesT (TCMT IO) (AbsN (AbsN Term))
    forall (m :: * -> *) a.
    (Monad m, Subst a) =>
    NamesT m (AbsN a) -> [NamesT m (SubstArg a)] -> NamesT m a
    `applyN` [NamesT (TCMT IO) Term]
    -> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
    -> [NamesT (TCMT IO) Term]
    forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
    for [NamesT (TCMT IO) Term]
    delta (\ NamesT (TCMT IO) Term
    p -> String
    -> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
    -> NamesT (TCMT IO) Term
    forall (m :: * -> *).
    Monad m =>
    String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
    lam String
    "i" ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
     -> NamesT (TCMT IO) Term)
    -> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
    -> NamesT (TCMT IO) Term
    forall a b. (a -> b) -> a -> b
    $ \ NamesT (TCMT IO) Term
    i -> NamesT (TCMT IO) Term
    p NamesT (TCMT IO) Term
    -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <@> (NamesT (TCMT IO) Term
    i NamesT (TCMT IO) Term
    -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
    forall {m :: * -> *}.
    (HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
    NamesT m Term -> NamesT m Term -> NamesT m Term
    `min` NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
    forall {m :: * -> *}.
    (HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
    NamesT m Term -> NamesT m Term
    neg NamesT (TCMT IO) Term
    j))
                                          NamesT (TCMT IO) (AbsN (AbsN Term))
    -> [NamesT (TCMT IO) (SubstArg (AbsN Term))]
    -> NamesT (TCMT IO) (AbsN Term)
    forall (m :: * -> *) a.
    (Monad m, Subst a) =>
    NamesT m (AbsN a) -> [NamesT m (SubstArg a)] -> NamesT m a
    `applyN` [NamesT (TCMT IO) Term]
    -> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
    -> [NamesT (TCMT IO) Term]
    forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
    for [NamesT (TCMT IO) Term]
    x_tr (\ NamesT (TCMT IO) Term
    p -> String
    -> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
    -> NamesT (TCMT IO) Term
    forall (m :: * -> *).
    Monad m =>
    String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
    lam String
    "i" ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
     -> NamesT (TCMT IO) Term)
    -> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
    -> NamesT (TCMT IO) Term
    forall a b. (a -> b) -> a -> b
    $ \ NamesT (TCMT IO) Term
    i -> NamesT (TCMT IO) Term
    p NamesT (TCMT IO) Term
    -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <@> (NamesT (TCMT IO) Term
    i NamesT (TCMT IO) Term
    -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
    forall {m :: * -> *}.
    (HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
    NamesT m Term -> NamesT m Term -> NamesT m Term
    `min` NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
    forall {m :: * -> *}.
    (HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
    NamesT m Term -> NamesT m Term
    neg NamesT (TCMT IO) Term
    j))
                                          NamesT (TCMT IO) (AbsN Term)
    -> [NamesT (TCMT IO) (SubstArg Term)] -> NamesT (TCMT IO) Term
    forall (m :: * -> *) a.
    (Monad m, Subst a) =>
    NamesT m (AbsN a) -> [NamesT m (SubstArg a)] -> NamesT m a
    `applyN` [(NamesT (TCMT IO) Term
    phi NamesT (TCMT IO) Term
    -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
    forall {m :: * -> *}.
    (HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
    NamesT m Term -> NamesT m Term -> NamesT m Term
    `min` NamesT (TCMT IO) Term
    phi') NamesT (TCMT IO) Term
    -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
    forall {m :: * -> *}.
    (HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
    NamesT m Term -> NamesT m Term -> NamesT m Term
    `max` NamesT (TCMT IO) Term
    j,NamesT (TCMT IO) Term
    NamesT (TCMT IO) (SubstArg Term)
    t]
                          let x_tr_f :: NamesT (TCMT IO) [Arg Term]
    x_tr_f = (Abs [Arg Term] -> [Arg Term])
    -> NamesT (TCMT IO) (Abs [Arg Term]) -> NamesT (TCMT IO) [Arg Term]
    forall a b. (a -> b) -> NamesT (TCMT IO) a -> NamesT (TCMT IO) b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((Abs (Arg Term) -> Arg Term) -> [Abs (Arg Term)] -> [Arg Term]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (\ (Abs String
    n (Arg ArgInfo
    i Term
    t)) -> ArgInfo -> Term -> Arg Term
    forall e. ArgInfo -> e -> Arg e
    Arg ArgInfo
    i (Term -> Arg Term) -> Term -> Arg Term
    forall a b. (a -> b) -> a -> b
    $ ArgInfo -> Abs Term -> Term
    Lam ArgInfo
    defaultArgInfo (String -> Term -> Abs Term
    forall a. String -> a -> Abs a
    Abs String
    n Term
    t)) ([Abs (Arg Term)] -> [Arg Term])
    -> (Abs [Arg Term] -> [Abs (Arg Term)])
    -> Abs [Arg Term]
    -> [Arg Term]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Abs [Arg Term] -> [Abs (Arg Term)]
    forall (t :: * -> *) (m :: * -> *) a.
    (Traversable t, Monad m) =>
    t (m a) -> m (t a)
    forall (m :: * -> *) a. Monad m => Abs (m a) -> m (Abs a)
    sequence) (NamesT (TCMT IO) (Abs [Arg Term]) -> NamesT (TCMT IO) [Arg Term])
    -> NamesT (TCMT IO) (Abs [Arg Term]) -> NamesT (TCMT IO) [Arg Term]
    forall a b. (a -> b) -> a -> b
    $
                               String
    -> ((forall b. (Subst b, DeBruijn b) => NamesT (TCMT IO) b)
        -> NamesT (TCMT IO) [Arg Term])
    -> NamesT (TCMT IO) (Abs [Arg Term])
    forall (m :: * -> *) a.
    Monad m =>
    String
    -> ((forall b. (Subst b, DeBruijn b) => NamesT m b) -> NamesT m a)
    -> NamesT m (Abs a)
    bind String
    "i" (((forall b. (Subst b, DeBruijn b) => NamesT (TCMT IO) b)
      -> NamesT (TCMT IO) [Arg Term])
     -> NamesT (TCMT IO) (Abs [Arg Term]))
    -> ((forall b. (Subst b, DeBruijn b) => NamesT (TCMT IO) b)
        -> NamesT (TCMT IO) [Arg Term])
    -> NamesT (TCMT IO) (Abs [Arg Term])
    forall a b. (a -> b) -> a -> b
    $ \ forall b. (Subst b, DeBruijn b) => NamesT (TCMT IO) b
    i -> do
                                j <- NamesT (TCMT IO) Term
    j
                                map (fmap (`apply` [argN j])) <$> trFillPathTel' telXdeltai symx' reflx1 phi' x (neg i)
                          let args :: NamesT (TCMT IO) [Arg Term]
    args = ([Arg Term] -> [Arg Term] -> [Arg Term])
    -> NamesT (TCMT IO) [Arg Term]
    -> NamesT (TCMT IO) [Arg Term]
    -> NamesT (TCMT IO) [Arg Term]
    forall (m :: * -> *) a1 a2 r.
    Monad m =>
    (a1 -> a2 -> r) -> m a1 -> m a2 -> m r
    liftM2 [Arg Term] -> [Arg Term] -> [Arg Term]
    forall a. [a] -> [a] -> [a]
    (++) ((Arg Term -> Arg Term) -> [Arg Term] -> [Arg Term]
    forall a b. (a -> b) -> [a] -> [b]
    map (Hiding -> Arg Term -> Arg Term
    forall a. LensHiding a => Hiding -> a -> a
    setHiding Hiding
    Hidden) ([Arg Term] -> [Arg Term])
    -> NamesT (TCMT IO) [Arg Term] -> NamesT (TCMT IO) [Arg Term]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> NamesT (TCMT IO) Term -> NamesT (TCMT IO) [Arg Term]
    deltaArg (Term -> NamesT (TCMT IO) Term
    forall a. a -> NamesT (TCMT IO) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Term
    io)) NamesT (TCMT IO) [Arg Term]
    x_tr_f
                          (Term -> [Arg Term] -> Term
    forall t. Apply t => t -> [Arg Term] -> t
    apply (QName -> [Elim' Term] -> Term
    Def QName
    trX []) ([Arg Term] -> Term)
    -> NamesT (TCMT IO) [Arg Term] -> NamesT (TCMT IO) Term
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> NamesT (TCMT IO) [Arg Term]
    args) NamesT (TCMT IO) Term
    -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <@> (NamesT (TCMT IO) Term
    phi' NamesT (TCMT IO) Term
    -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
    forall {m :: * -> *}.
    (HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
    NamesT m Term -> NamesT m Term -> NamesT m Term
    `max` NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
    forall {m :: * -> *}.
    (HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
    NamesT m Term -> NamesT m Term
    neg NamesT (TCMT IO) Term
    j) NamesT (TCMT IO) Term
    -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <@> NamesT (TCMT IO) Term
    trD_f
                    hcomp rhsTy [(phi,sideTrX),(phi',lam "i" $ \ NamesT (TCMT IO) Term
    _ -> String
    -> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
    -> NamesT (TCMT IO) Term
    forall (m :: * -> *).
    Monad m =>
    String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
    ilam String
    "o" ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
     -> NamesT (TCMT IO) Term)
    -> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
    -> NamesT (TCMT IO) Term
    forall a b. (a -> b) -> a -> b
    $ \ NamesT (TCMT IO) Term
    _ -> NamesT (TCMT IO) Term
    baseTrX)]
                                baseTrX

              (,,) ([Arg (Named_ (Pattern' DBPatVar))]
     -> Type
     -> Term
     -> ([Arg (Named_ (Pattern' DBPatVar))], Type, Term))
    -> NamesT (TCMT IO) [Arg (Named_ (Pattern' DBPatVar))]
    -> NamesT
         (TCMT IO)
         (Type -> Term -> ([Arg (Named_ (Pattern' DBPatVar))], Type, Term))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> NamesT (TCMT IO) [Arg (Named_ (Pattern' DBPatVar))]
    psTrX NamesT
      (TCMT IO)
      (Type -> Term -> ([Arg (Named_ (Pattern' DBPatVar))], Type, Term))
    -> NamesT (TCMT IO) Type
    -> NamesT
         (TCMT IO)
         (Term -> ([Arg (Named_ (Pattern' DBPatVar))], Type, Term))
    forall a b.
    NamesT (TCMT IO) (a -> b)
    -> NamesT (TCMT IO) a -> NamesT (TCMT IO) b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> NamesT (TCMT IO) Type
    rhsTy NamesT
      (TCMT IO)
      (Term -> ([Arg (Named_ (Pattern' DBPatVar))], Type, Term))
    -> NamesT (TCMT IO) Term
    -> NamesT
         (TCMT IO) ([Arg (Named_ (Pattern' DBPatVar))], Type, Term)
    forall a b.
    NamesT (TCMT IO) (a -> b)
    -> NamesT (TCMT IO) a -> NamesT (TCMT IO) b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> NamesT (TCMT IO) Term
    rhsTrX

            let (ps,rhsTy,rhs) = unAbsN $ unAbsN $ unAbsN $ unAbsN $ unAbsN $ unAbsN $ res
            (:[]) <$> mkClause gamma ps rhsTy rhs

      fmap ((c_HComp ++ c_trX) ++) $ forM cnames $ \ QName
    cname -> do
        def <- QName -> TCMT IO Definition
    forall (m :: * -> *). HasConstInfo m => QName -> m Definition
    getConstInfo QName
    cname
        let
          Constructor
           { conPars = npars'
           , conArity = nargs
           , conSrcCon = chead
           } = theDef def
        do
            let tcon = Definition -> Type
    defType Definition
    def

            reportSDoc "tc.data.transp.con" 20 $ "======================="
            reportSDoc "tc.data.transp.con" 20 $ "tcon:" <+> prettyTCM (conName chead) <+> prettyTCM tcon

            unless (conName chead == cname && npars' == npars) $ __IMPOSSIBLE__

            TelV prm tcon' <- telViewUpTo npars' tcon
            -- Δ ⊢ aTel
            -- Δ.aTel ⊢ ty
            -- Δ.aTel ⊢ [(φ,(l,r))] = boundary : ty
            (TelV aTel ty, boundary) <- telViewUpToPathBoundary nargs tcon'

            Def _ es <- unEl <$> reduce ty
            -- Δ.aTel ⊢ con_ixs : X
            let con_ixs = [Arg Term] -> Maybe [Arg Term] -> [Arg Term]
    forall a. a -> Maybe a -> a
    fromMaybe [Arg Term]
    forall a. HasCallStack => a
    __IMPOSSIBLE__ (Maybe [Arg Term] -> [Arg Term]) -> Maybe [Arg Term] -> [Arg Term]
    forall a b. (a -> b) -> a -> b
    $ [Elim' Term] -> Maybe [Arg Term]
    forall a. [Elim' a] -> Maybe [Arg a]
    allApplyElims ([Elim' Term] -> Maybe [Arg Term])
    -> [Elim' Term] -> Maybe [Arg Term]
    forall a b. (a -> b) -> a -> b
    $ Nat -> [Elim' Term] -> [Elim' Term]
    forall a. Nat -> [a] -> [a]
    drop Nat
    npars [Elim' Term]
    es

            reportSDoc "tc.data.transp.con" 20 $
              addContext prm $ "aTel:" <+> prettyTCM aTel
            reportSDoc "tc.data.transp.con" 20 $
              addContext prm $ addContext aTel $ "ty:" <+> prettyTCM ty
            reportSDoc "tc.data.transp.con" 20 $
              addContext prm $ addContext aTel $ "boundary:" <+> prettyTCM boundary

            gamma <- runNamesT [] $ do
                         ixsI <- open $ AbsN (teleNames parI) ixsI
                         aTel <- open $ AbsN (teleNames prm) aTel
                         parI <- open parI
                         abstract_trD $ \ Vars (TCMT IO)
    delta Vars (TCMT IO)
    _ Vars (TCMT IO)
    _ -> do
                         let args :: NamesT (TCMT IO) (Tele (Dom Type))
    args = NamesT (TCMT IO) (AbsN (Tele (Dom Type)))
    aTel NamesT (TCMT IO) (AbsN (Tele (Dom Type)))
    -> [NamesT (TCMT IO) (SubstArg (Tele (Dom Type)))]
    -> NamesT (TCMT IO) (Tele (Dom Type))
    forall (m :: * -> *) a.
    (Monad m, Subst a) =>
    NamesT m (AbsN a) -> [NamesT m (SubstArg a)] -> NamesT m a
    `applyN` (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
    -> [NamesT (TCMT IO) Term] -> [NamesT (TCMT IO) Term]
    forall a b. (a -> b) -> [a] -> [b]
    map (NamesT (TCMT IO) Term
    -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <@> Term -> NamesT (TCMT IO) Term
    forall a. a -> NamesT (TCMT IO) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Term
    iz) [NamesT (TCMT IO) Term]
    Vars (TCMT IO)
    delta
                         NamesT (TCMT IO) (Tele (Dom Type))
    args
            res <- runNamesT [] $ do
              let aTelNames = Tele (Dom Type) -> Names
    teleNames Tele (Dom Type)
    aTel
                  aTelArgs = Tele (Dom Type) -> [Arg String]
    teleArgNames Tele (Dom Type)
    aTel
              con_ixs <- open $ AbsN (teleNames prm ++ teleNames aTel) $ map unArg con_ixs
              bndry <- open $ AbsN (teleNames prm ++ teleNames aTel) $ tmBoundary boundary
              u    <- open $ AbsN (teleNames prm ++ aTelNames) $ Con chead ConOSystem (teleElims aTel boundary)
              aTel <- open $ AbsN (teleNames prm) aTel
              -- bsys : Abs Δ.Args ([phi] → ty)
              (bsysFace,bsys) <- do
                p <- bindN (teleNames prm ++ aTelNames) $ \ Vars (TCMT IO)
    ts -> do
                  LEl l ty <- LType -> Maybe LType -> LType
    forall a. a -> Maybe a -> a
    fromMaybe LType
    forall a. HasCallStack => a
    __IMPOSSIBLE__ (Maybe LType -> LType)
    -> NamesT (TCMT IO) (Maybe LType) -> NamesT (TCMT IO) LType
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Type -> NamesT (TCMT IO) (Maybe LType)
    forall (m :: * -> *). MonadReduce m => Type -> m (Maybe LType)
    toLType Type
    ty
                  l <- open (Level l)
                  ty <- open ty
                  bs <- bndry `applyN` ts
                  xs <- mapM (\(Term
    phi,Term
    u) -> (,) (NamesT (TCMT IO) Term
     -> NamesT (TCMT IO) Term
     -> (NamesT (TCMT IO) Term, NamesT (TCMT IO) Term))
    -> NamesT (TCMT IO) (NamesT (TCMT IO) Term)
    -> NamesT
         (TCMT IO)
         (NamesT (TCMT IO) Term
          -> (NamesT (TCMT IO) Term, NamesT (TCMT IO) Term))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Term -> NamesT (TCMT IO) (NamesT (TCMT IO) Term)
    forall (m :: * -> *) a.
    (Monad m, Subst a) =>
    a -> NamesT m (NamesT m a)
    open Term
    phi NamesT
      (TCMT IO)
      (NamesT (TCMT IO) Term
       -> (NamesT (TCMT IO) Term, NamesT (TCMT IO) Term))
    -> NamesT (TCMT IO) (NamesT (TCMT IO) Term)
    -> NamesT (TCMT IO) (NamesT (TCMT IO) Term, NamesT (TCMT IO) Term)
    forall a b.
    NamesT (TCMT IO) (a -> b)
    -> NamesT (TCMT IO) a -> NamesT (TCMT IO) b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Term -> NamesT (TCMT IO) (NamesT (TCMT IO) Term)
    forall (m :: * -> *) a.
    (Monad m, Subst a) =>
    a -> NamesT m (NamesT m a)
    open Term
    u) $ do
                    (i,(l,r)) <- theBoundary bs
                    let pElem Term
    t = ArgInfo -> Abs Term -> Term
    Lam ArgInfo
    defaultIrrelevantArgInfo (Abs Term -> Term) -> Abs Term -> Term
    forall a b. (a -> b) -> a -> b
    $ String -> Term -> Abs Term
    forall a. String -> a -> Abs a
    NoAbs String
    "o" Term
    t
                    [(tINeg `apply` [argN i],pElem l),(i,pElem r)]
                  combineSys' l ty xs
                (,) <$> open (fst <$> p) <*> open (snd <$> p)
              bind_trD $ \ ArgVars (TCMT IO)
    delta_ps ArgVars (TCMT IO)
    x_ps ArgVars (TCMT IO)
    phi_ps -> do
              let x :: [NamesT (TCMT IO) Term]
    x = (NamesT (TCMT IO) (Arg Term) -> NamesT (TCMT IO) Term)
    -> [NamesT (TCMT IO) (Arg Term)] -> [NamesT (TCMT IO) Term]
    forall a b. (a -> b) -> [a] -> [b]
    map ((Arg Term -> Term)
    -> NamesT (TCMT IO) (Arg Term) -> NamesT (TCMT IO) Term
    forall a b. (a -> b) -> NamesT (TCMT IO) a -> NamesT (TCMT IO) b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Arg Term -> Term
    forall e. Arg e -> e
    unArg) [NamesT (TCMT IO) (Arg Term)]
    ArgVars (TCMT IO)
    x_ps
              let delta :: [NamesT (TCMT IO) Term]
    delta = (NamesT (TCMT IO) (Arg Term) -> NamesT (TCMT IO) Term)
    -> [NamesT (TCMT IO) (Arg Term)] -> [NamesT (TCMT IO) Term]
    forall a b. (a -> b) -> [a] -> [b]
    map ((Arg Term -> Term)
    -> NamesT (TCMT IO) (Arg Term) -> NamesT (TCMT IO) Term
    forall a b. (a -> b) -> NamesT (TCMT IO) a -> NamesT (TCMT IO) b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Arg Term -> Term
    forall e. Arg e -> e
    unArg) [NamesT (TCMT IO) (Arg Term)]
    ArgVars (TCMT IO)
    delta_ps
              let [NamesT (TCMT IO) Term
    phi] = (NamesT (TCMT IO) (Arg Term) -> NamesT (TCMT IO) Term)
    -> [NamesT (TCMT IO) (Arg Term)] -> [NamesT (TCMT IO) Term]
    forall a b. (a -> b) -> [a] -> [b]
    map ((Arg Term -> Term)
    -> NamesT (TCMT IO) (Arg Term) -> NamesT (TCMT IO) Term
    forall a b. (a -> b) -> NamesT (TCMT IO) a -> NamesT (TCMT IO) b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Arg Term -> Term
    forall e. Arg e -> e
    unArg) [NamesT (TCMT IO) (Arg Term)]
    ArgVars (TCMT IO)
    phi_ps
              --- pattern matching args below
              [Arg String]
    -> (ArgVars (TCMT IO)
        -> NamesT
             (TCMT IO) ([Arg (Named_ (Pattern' DBPatVar))], Type, Term))
    -> NamesT
         (TCMT IO) (AbsN ([Arg (Named_ (Pattern' DBPatVar))], Type, Term))
    forall (m :: * -> *) a.
    Monad m =>
    [Arg String] -> (ArgVars m -> NamesT m a) -> NamesT m (AbsN a)
    bindNArg [Arg String]
    aTelArgs ((ArgVars (TCMT IO)
      -> NamesT
           (TCMT IO) ([Arg (Named_ (Pattern' DBPatVar))], Type, Term))
     -> NamesT
          (TCMT IO) (AbsN ([Arg (Named_ (Pattern' DBPatVar))], Type, Term)))
    -> (ArgVars (TCMT IO)
        -> NamesT
             (TCMT IO) ([Arg (Named_ (Pattern' DBPatVar))], Type, Term))
    -> NamesT
         (TCMT IO) (AbsN ([Arg (Named_ (Pattern' DBPatVar))], Type, Term))
    forall a b. (a -> b) -> a -> b
    $ \ ArgVars (TCMT IO)
    as0 -> do -- as0 : aTel[delta 0]

              let aTel0 :: NamesT (TCMT IO) (Tele (Dom Type))
    aTel0 = NamesT (TCMT IO) (AbsN (Tele (Dom Type)))
    aTel NamesT (TCMT IO) (AbsN (Tele (Dom Type)))
    -> [NamesT (TCMT IO) (SubstArg (Tele (Dom Type)))]
    -> NamesT (TCMT IO) (Tele (Dom Type))
    forall (m :: * -> *) a.
    (Monad m, Subst a) =>
    NamesT m (AbsN a) -> [NamesT m (SubstArg a)] -> NamesT m a
    `applyN` (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
    -> [NamesT (TCMT IO) Term] -> [NamesT (TCMT IO) Term]
    forall a b. (a -> b) -> [a] -> [b]
    map (NamesT (TCMT IO) Term
    -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <@> Term -> NamesT (TCMT IO) Term
    forall a. a -> NamesT (TCMT IO) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Term
    iz) [NamesT (TCMT IO) Term]
    delta

              -- telePatterns is not context invariant, so we need an open here where the context ends in aTel0.
              ps0 <- ([Arg (Named_ (Pattern' DBPatVar))]
    -> NamesT
         (TCMT IO) (NamesT (TCMT IO) [Arg (Named_ (Pattern' DBPatVar))])
    forall (m :: * -> *) a.
    (Monad m, Subst a) =>
    a -> NamesT m (NamesT m a)
    open ([Arg (Named_ (Pattern' DBPatVar))]
     -> NamesT
          (TCMT IO) (NamesT (TCMT IO) [Arg (Named_ (Pattern' DBPatVar))]))
    -> NamesT (TCMT IO) [Arg (Named_ (Pattern' DBPatVar))]
    -> NamesT
         (TCMT IO) (NamesT (TCMT IO) [Arg (Named_ (Pattern' DBPatVar))])
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<<) (NamesT (TCMT IO) [Arg (Named_ (Pattern' DBPatVar))]
     -> NamesT
          (TCMT IO) (NamesT (TCMT IO) [Arg (Named_ (Pattern' DBPatVar))]))
    -> NamesT (TCMT IO) [Arg (Named_ (Pattern' DBPatVar))]
    -> NamesT
         (TCMT IO) (NamesT (TCMT IO) [Arg (Named_ (Pattern' DBPatVar))])
    forall a b. (a -> b) -> a -> b
    $ (Tele (Dom Type) -> Boundary -> [Arg (Named_ (Pattern' DBPatVar))]
    forall a.
    DeBruijn a =>
    Tele (Dom Type) -> Boundary -> [NamedArg (Pattern' a)]
    telePatterns (Tele (Dom Type) -> Boundary -> [Arg (Named_ (Pattern' DBPatVar))])
    -> NamesT (TCMT IO) (Tele (Dom Type))
    -> NamesT
         (TCMT IO) (Boundary -> [Arg (Named_ (Pattern' DBPatVar))])
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> NamesT (TCMT IO) (Tele (Dom Type))
    aTel0 NamesT (TCMT IO) (Boundary -> [Arg (Named_ (Pattern' DBPatVar))])
    -> NamesT (TCMT IO) Boundary
    -> NamesT (TCMT IO) [Arg (Named_ (Pattern' DBPatVar))]
    forall a b.
    NamesT (TCMT IO) (a -> b)
    -> NamesT (TCMT IO) a -> NamesT (TCMT IO) b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> (Boundary' Term Term -> Boundary
    forall a. Boundary' Term a -> Boundary' Nat a
    varBoundary (Boundary' Term Term -> Boundary)
    -> NamesT (TCMT IO) (Boundary' Term Term)
    -> NamesT (TCMT IO) Boundary
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> NamesT (TCMT IO) (AbsN (Boundary' Term Term))
    -> [NamesT (TCMT IO) (SubstArg (Boundary' Term Term))]
    -> NamesT (TCMT IO) (Boundary' Term Term)
    forall (m :: * -> *) a.
    (Monad m, Subst a) =>
    NamesT m (AbsN a) -> [NamesT m (SubstArg a)] -> NamesT m a
    applyN NamesT (TCMT IO) (AbsN (Boundary' Term Term))
    bndry ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
    -> [NamesT (TCMT IO) Term] -> [NamesT (TCMT IO) Term]
    forall a b. (a -> b) -> [a] -> [b]
    map (NamesT (TCMT IO) Term
    -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <@> Term -> NamesT (TCMT IO) Term
    forall a. a -> NamesT (TCMT IO) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Term
    iz) [NamesT (TCMT IO) Term]
    delta [NamesT (TCMT IO) Term]
    -> [NamesT (TCMT IO) Term] -> [NamesT (TCMT IO) Term]
    forall a. [a] -> [a] -> [a]
    ++ (NamesT (TCMT IO) (Arg Term) -> NamesT (TCMT IO) Term)
    -> [NamesT (TCMT IO) (Arg Term)] -> [NamesT (TCMT IO) Term]
    forall a b. (a -> b) -> [a] -> [b]
    map ((Arg Term -> Term)
    -> NamesT (TCMT IO) (Arg Term) -> NamesT (TCMT IO) Term
    forall a b. (a -> b) -> NamesT (TCMT IO) a -> NamesT (TCMT IO) b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Arg Term -> Term
    forall e. Arg e -> e
    unArg) [NamesT (TCMT IO) (Arg Term)]
    ArgVars (TCMT IO)
    as0)))

              let deltaArg NamesT (TCMT IO) Term
    i = do
                    i <- NamesT (TCMT IO) Term
    i
                    xs <- sequence delta_ps
                    pure $ map (fmap (`apply` [argN i])) xs

              let
                origP = ConHead
    -> ConPatternInfo
    -> [Arg (Named_ (Pattern' DBPatVar))]
    -> Pattern' DBPatVar
    forall x.
    ConHead -> ConPatternInfo -> [NamedArg (Pattern' x)] -> Pattern' x
    ConP ConHead
    chead ConPatternInfo
    noConPatternInfo ([Arg (Named_ (Pattern' DBPatVar))] -> Pattern' DBPatVar)
    -> NamesT (TCMT IO) [Arg (Named_ (Pattern' DBPatVar))]
    -> NamesT (TCMT IO) (Pattern' DBPatVar)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> NamesT (TCMT IO) [Arg (Named_ (Pattern' DBPatVar))]
    ps0
                ps = [NamesT (TCMT IO) (Arg (Named_ (Pattern' DBPatVar)))]
    -> NamesT (TCMT IO) [Arg (Named_ (Pattern' DBPatVar))]
    forall (t :: * -> *) (m :: * -> *) a.
    (Traversable t, Monad m) =>
    t (m a) -> m (t a)
    forall (m :: * -> *) a. Monad m => [m a] -> m [a]
    sequence ([NamesT (TCMT IO) (Arg (Named_ (Pattern' DBPatVar)))]
     -> NamesT (TCMT IO) [Arg (Named_ (Pattern' DBPatVar))])
    -> [NamesT (TCMT IO) (Arg (Named_ (Pattern' DBPatVar)))]
    -> NamesT (TCMT IO) [Arg (Named_ (Pattern' DBPatVar))]
    forall a b. (a -> b) -> a -> b
    $ [NamesT (TCMT IO) (Arg (Named_ (Pattern' DBPatVar)))]
    ArgVars (TCMT IO)
    delta_ps [NamesT (TCMT IO) (Arg (Named_ (Pattern' DBPatVar)))]
    -> [NamesT (TCMT IO) (Arg (Named_ (Pattern' DBPatVar)))]
    -> [NamesT (TCMT IO) (Arg (Named_ (Pattern' DBPatVar)))]
    forall a. [a] -> [a] -> [a]
    ++ [NamesT (TCMT IO) (Arg (Named_ (Pattern' DBPatVar)))]
    ArgVars (TCMT IO)
    x_ps [NamesT (TCMT IO) (Arg (Named_ (Pattern' DBPatVar)))]
    -> [NamesT (TCMT IO) (Arg (Named_ (Pattern' DBPatVar)))]
    -> [NamesT (TCMT IO) (Arg (Named_ (Pattern' DBPatVar)))]
    forall a. [a] -> [a] -> [a]
    ++ [NamesT (TCMT IO) (Arg (Named_ (Pattern' DBPatVar)))]
    ArgVars (TCMT IO)
    phi_ps [NamesT (TCMT IO) (Arg (Named_ (Pattern' DBPatVar)))]
    -> [NamesT (TCMT IO) (Arg (Named_ (Pattern' DBPatVar)))]
    -> [NamesT (TCMT IO) (Arg (Named_ (Pattern' DBPatVar)))]
    forall a. [a] -> [a] -> [a]
    ++ [Named_ (Pattern' DBPatVar) -> Arg (Named_ (Pattern' DBPatVar))
    forall e. e -> Arg e
    argN (Named_ (Pattern' DBPatVar) -> Arg (Named_ (Pattern' DBPatVar)))
    -> (Pattern' DBPatVar -> Named_ (Pattern' DBPatVar))
    -> Pattern' DBPatVar
    -> Arg (Named_ (Pattern' DBPatVar))
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Pattern' DBPatVar -> Named_ (Pattern' DBPatVar)
    forall a name. a -> Named name a
    unnamed (Pattern' DBPatVar -> Arg (Named_ (Pattern' DBPatVar)))
    -> NamesT (TCMT IO) (Pattern' DBPatVar)
    -> NamesT (TCMT IO) (Arg (Named_ (Pattern' DBPatVar)))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> NamesT (TCMT IO) (Pattern' DBPatVar)
    origP]
              let
                orig = Pattern' DBPatVar -> Term
    patternToTerm (Pattern' DBPatVar -> Term)
    -> NamesT (TCMT IO) (Pattern' DBPatVar) -> NamesT (TCMT IO) Term
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> NamesT (TCMT IO) (Pattern' DBPatVar)
    origP
                rhsTy = NamesT (TCMT IO) (AbsN Type)
    dT NamesT (TCMT IO) (AbsN Type)
    -> [NamesT (TCMT IO) (SubstArg Type)] -> NamesT (TCMT IO) Type
    forall (m :: * -> *) a.
    (Monad m, Subst a) =>
    NamesT m (AbsN a) -> [NamesT m (SubstArg a)] -> NamesT m a
    `applyN` ([NamesT (TCMT IO) Term]
    delta [NamesT (TCMT IO) Term]
    -> [NamesT (TCMT IO) Term] -> [NamesT (TCMT IO) Term]
    forall a. [a] -> [a] -> [a]
    ++ [NamesT (TCMT IO) Term]
    x [NamesT (TCMT IO) Term]
    -> [NamesT (TCMT IO) Term] -> [NamesT (TCMT IO) Term]
    forall a. [a] -> [a] -> [a]
    ++ [Term -> NamesT (TCMT IO) Term
    forall a. a -> NamesT (TCMT IO) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Term
    io])

              (,,) <$> ps <*> rhsTy <*> do

              -- Declared Constructors.
              let aTelI = String
    -> ((forall b. (Subst b, DeBruijn b) => NamesT (TCMT IO) b)
        -> NamesT (TCMT IO) (Tele (Dom Type)))
    -> NamesT (TCMT IO) (Abs (Tele (Dom Type)))
    forall (m :: * -> *) a.
    Monad m =>
    String
    -> ((forall b. (Subst b, DeBruijn b) => NamesT m b) -> NamesT m a)
    -> NamesT m (Abs a)
    bind String
    "i" (((forall b. (Subst b, DeBruijn b) => NamesT (TCMT IO) b)
      -> NamesT (TCMT IO) (Tele (Dom Type)))
     -> NamesT (TCMT IO) (Abs (Tele (Dom Type))))
    -> ((forall b. (Subst b, DeBruijn b) => NamesT (TCMT IO) b)
        -> NamesT (TCMT IO) (Tele (Dom Type)))
    -> NamesT (TCMT IO) (Abs (Tele (Dom Type)))
    forall a b. (a -> b) -> a -> b
    $ \ forall b. (Subst b, DeBruijn b) => NamesT (TCMT IO) b
    i -> NamesT (TCMT IO) (AbsN (Tele (Dom Type)))
    aTel NamesT (TCMT IO) (AbsN (Tele (Dom Type)))
    -> [NamesT (TCMT IO) (SubstArg (Tele (Dom Type)))]
    -> NamesT (TCMT IO) (Tele (Dom Type))
    forall (m :: * -> *) a.
    (Monad m, Subst a) =>
    NamesT m (AbsN a) -> [NamesT m (SubstArg a)] -> NamesT m a
    `applyN` (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
    -> [NamesT (TCMT IO) Term] -> [NamesT (TCMT IO) Term]
    forall a b. (a -> b) -> [a] -> [b]
    map (NamesT (TCMT IO) Term
    -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <@> NamesT (TCMT IO) Term
    forall b. (Subst b, DeBruijn b) => NamesT (TCMT IO) b
    i) [NamesT (TCMT IO) Term]
    delta

              eas1 <- (=<<) (lift . runExceptT) $ transpTel <$> aTelI <*> phi <*> sequence as0

              caseEitherM (pure eas1) (lift . lift . E.throw . CannotTransp) $ \ [Arg Term]
    as1 -> do

              as1 <- (Arg Term -> NamesT (TCMT IO) (NamesT (TCMT IO) Term))
    -> [Arg Term] -> NamesT (TCMT IO) [NamesT (TCMT IO) Term]
    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 (Term -> NamesT (TCMT IO) (NamesT (TCMT IO) Term)
    forall (m :: * -> *) a.
    (Monad m, Subst a) =>
    a -> NamesT m (NamesT m a)
    open (Term -> NamesT (TCMT IO) (NamesT (TCMT IO) Term))
    -> (Arg Term -> Term)
    -> Arg Term
    -> NamesT (TCMT IO) (NamesT (TCMT IO) Term)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Arg Term -> Term
    forall e. Arg e -> e
    unArg) [Arg Term]
    as1

              as01 <- (open =<<) $ bind "i" $ \ forall b. (Subst b, DeBruijn b) => NamesT (TCMT IO) b
    i -> do
                eas01 <- (ExceptT (Closure (Abs Type)) (TCMT IO) [Arg Term]
     -> NamesT (TCMT IO) (Either (Closure (Abs Type)) [Arg Term]))
    -> NamesT
         (TCMT IO) (ExceptT (Closure (Abs Type)) (TCMT IO) [Arg Term])
    -> NamesT (TCMT IO) (Either (Closure (Abs Type)) [Arg Term])
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    (=<<) (TCMT IO (Either (Closure (Abs Type)) [Arg Term])
    -> NamesT (TCMT IO) (Either (Closure (Abs Type)) [Arg Term])
    forall (m :: * -> *) a. Monad m => m a -> NamesT m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (TCMT IO (Either (Closure (Abs Type)) [Arg Term])
     -> NamesT (TCMT IO) (Either (Closure (Abs Type)) [Arg Term]))
    -> (ExceptT (Closure (Abs Type)) (TCMT IO) [Arg Term]
        -> TCMT IO (Either (Closure (Abs Type)) [Arg Term]))
    -> ExceptT (Closure (Abs Type)) (TCMT IO) [Arg Term]
    -> NamesT (TCMT IO) (Either (Closure (Abs Type)) [Arg Term])
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ExceptT (Closure (Abs Type)) (TCMT IO) [Arg Term]
    -> TCMT IO (Either (Closure (Abs Type)) [Arg Term])
    forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
    runExceptT) (NamesT
       (TCMT IO) (ExceptT (Closure (Abs Type)) (TCMT IO) [Arg Term])
     -> NamesT (TCMT IO) (Either (Closure (Abs Type)) [Arg Term]))
    -> NamesT
         (TCMT IO) (ExceptT (Closure (Abs Type)) (TCMT IO) [Arg Term])
    -> NamesT (TCMT IO) (Either (Closure (Abs Type)) [Arg Term])
    forall a b. (a -> b) -> a -> b
    $ Abs (Tele (Dom Type))
    -> Term
    -> [Arg Term]
    -> Term
    -> ExceptT (Closure (Abs Type)) (TCMT IO) [Arg Term]
    trFillTel (Abs (Tele (Dom Type))
     -> Term
     -> [Arg Term]
     -> Term
     -> ExceptT (Closure (Abs Type)) (TCMT IO) [Arg Term])
    -> NamesT (TCMT IO) (Abs (Tele (Dom Type)))
    -> NamesT
         (TCMT IO)
         (Term
          -> [Arg Term]
          -> Term
          -> ExceptT (Closure (Abs Type)) (TCMT IO) [Arg Term])
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> NamesT (TCMT IO) (Abs (Tele (Dom Type)))
    aTelI NamesT
      (TCMT IO)
      (Term
       -> [Arg Term]
       -> Term
       -> ExceptT (Closure (Abs Type)) (TCMT IO) [Arg Term])
    -> NamesT (TCMT IO) Term
    -> NamesT
         (TCMT IO)
         ([Arg Term]
          -> Term -> ExceptT (Closure (Abs Type)) (TCMT IO) [Arg Term])
    forall a b.
    NamesT (TCMT IO) (a -> b)
    -> NamesT (TCMT IO) a -> NamesT (TCMT IO) b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> NamesT (TCMT IO) Term
    phi NamesT
      (TCMT IO)
      ([Arg Term]
       -> Term -> ExceptT (Closure (Abs Type)) (TCMT IO) [Arg Term])
    -> NamesT (TCMT IO) [Arg Term]
    -> NamesT
         (TCMT IO)
         (Term -> ExceptT (Closure (Abs Type)) (TCMT IO) [Arg Term])
    forall a b.
    NamesT (TCMT IO) (a -> b)
    -> NamesT (TCMT IO) a -> NamesT (TCMT IO) b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> [NamesT (TCMT IO) (Arg Term)] -> NamesT (TCMT IO) [Arg Term]
    forall (t :: * -> *) (m :: * -> *) a.
    (Traversable t, Monad m) =>
    t (m a) -> m (t a)
    forall (m :: * -> *) a. Monad m => [m a] -> m [a]
    sequence [NamesT (TCMT IO) (Arg Term)]
    ArgVars (TCMT IO)
    as0 NamesT
      (TCMT IO)
      (Term -> ExceptT (Closure (Abs Type)) (TCMT IO) [Arg Term])
    -> NamesT (TCMT IO) Term
    -> NamesT
         (TCMT IO) (ExceptT (Closure (Abs Type)) (TCMT IO) [Arg Term])
    forall a b.
    NamesT (TCMT IO) (a -> b)
    -> NamesT (TCMT IO) a -> NamesT (TCMT IO) b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> NamesT (TCMT IO) Term
    forall b. (Subst b, DeBruijn b) => NamesT (TCMT IO) b
    i
                caseEitherM (pure eas01) (lift . lift . E.throw . CannotTransp) pure

              let argApp m (f b)
    a m Term
    t = (f b -> Term -> f b) -> m (f b) -> m Term -> m (f b)
    forall (m :: * -> *) a1 a2 r.
    Monad m =>
    (a1 -> a2 -> r) -> m a1 -> m a2 -> m r
    liftM2 (\ f b
    a Term
    t -> (b -> b) -> f b -> f b
    forall a b. (a -> b) -> f a -> f b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (b -> [Arg Term] -> b
    forall t. Apply t => t -> [Arg Term] -> t
    `apply` [Term -> Arg Term
    forall e. e -> Arg e
    argN Term
    t]) f b
    a) m (f b)
    a m Term
    t
              let
                argLam :: Monad m => String -> (Var m -> NamesT m (Arg Term)) -> NamesT m (Arg Term)
                argLam String
    n Var m -> NamesT m (Arg Term)
    f = (\ (Abs String
    n (Arg ArgInfo
    i Term
    t)) -> ArgInfo -> Term -> Arg Term
    forall e. ArgInfo -> e -> Arg e
    Arg ArgInfo
    i (Term -> Arg Term) -> Term -> Arg Term
    forall a b. (a -> b) -> a -> b
    $ ArgInfo -> Abs Term -> Term
    Lam ArgInfo
    defaultArgInfo (Abs Term -> Term) -> Abs Term -> Term
    forall a b. (a -> b) -> a -> b
    $ String -> Term -> Abs Term
    forall a. String -> a -> Abs a
    Abs String
    n Term
    t) (Abs (Arg Term) -> Arg Term)
    -> NamesT m (Abs (Arg Term)) -> NamesT m (Arg Term)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> String
    -> (Var m -> NamesT m (Arg Term)) -> NamesT m (Abs (Arg Term))
    forall (m :: * -> *) a.
    Monad m =>
    String
    -> ((forall b. (Subst b, DeBruijn b) => NamesT m b) -> NamesT m a)
    -> NamesT m (Abs a)
    bind String
    "n" Var m -> NamesT m (Arg Term)
    f
              let cas1 = NamesT (TCMT IO) (AbsN Term)
    -> [NamesT (TCMT IO) (SubstArg Term)] -> NamesT (TCMT IO) Term
    forall (m :: * -> *) a.
    (Monad m, Subst a) =>
    NamesT m (AbsN a) -> [NamesT m (SubstArg a)] -> NamesT m a
    applyN NamesT (TCMT IO) (AbsN Term)
    u ([NamesT (TCMT IO) (SubstArg Term)] -> NamesT (TCMT IO) Term)
    -> [NamesT (TCMT IO) (SubstArg Term)] -> NamesT (TCMT IO) Term
    forall a b. (a -> b) -> a -> b
    $ (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
    -> [NamesT (TCMT IO) Term] -> [NamesT (TCMT IO) Term]
    forall a b. (a -> b) -> [a] -> [b]
    map (NamesT (TCMT IO) Term
    -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <@> Term -> NamesT (TCMT IO) Term
    forall a. a -> NamesT (TCMT IO) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Term
    io) [NamesT (TCMT IO) Term]
    delta [NamesT (TCMT IO) Term]
    -> [NamesT (TCMT IO) Term] -> [NamesT (TCMT IO) Term]
    forall a. [a] -> [a] -> [a]
    ++ [NamesT (TCMT IO) Term]
    as1

              let base | Maybe QName
    Nothing <- Maybe QName
    mtrX = NamesT (TCMT IO) Term
    cas1
                       | Just QName
    trX <- Maybe QName
    mtrX = do
                           let theTel :: NamesT (TCMT IO) (Abs (Abs (Tele (Dom Type))))
    theTel = String
    -> ((forall b. (Subst b, DeBruijn b) => NamesT (TCMT IO) b)
        -> NamesT (TCMT IO) (Abs (Tele (Dom Type))))
    -> NamesT (TCMT IO) (Abs (Abs (Tele (Dom Type))))
    forall (m :: * -> *) a.
    Monad m =>
    String
    -> ((forall b. (Subst b, DeBruijn b) => NamesT m b) -> NamesT m a)
    -> NamesT m (Abs a)
    bind String
    "j" (((forall b. (Subst b, DeBruijn b) => NamesT (TCMT IO) b)
      -> NamesT (TCMT IO) (Abs (Tele (Dom Type))))
     -> NamesT (TCMT IO) (Abs (Abs (Tele (Dom Type)))))
    -> ((forall b. (Subst b, DeBruijn b) => NamesT (TCMT IO) b)
        -> NamesT (TCMT IO) (Abs (Tele (Dom Type))))
    -> NamesT (TCMT IO) (Abs (Abs (Tele (Dom Type))))
    forall a b. (a -> b) -> a -> b
    $ \ forall b. (Subst b, DeBruijn b) => NamesT (TCMT IO) b
    j -> String
    -> ((forall b. (Subst b, DeBruijn b) => NamesT (TCMT IO) b)
        -> NamesT (TCMT IO) (Tele (Dom Type)))
    -> NamesT (TCMT IO) (Abs (Tele (Dom Type)))
    forall (m :: * -> *) a.
    Monad m =>
    String
    -> ((forall b. (Subst b, DeBruijn b) => NamesT m b) -> NamesT m a)
    -> NamesT m (Abs a)
    bind String
    "i" (((forall b. (Subst b, DeBruijn b) => NamesT (TCMT IO) b)
      -> NamesT (TCMT IO) (Tele (Dom Type)))
     -> NamesT (TCMT IO) (Abs (Tele (Dom Type))))
    -> ((forall b. (Subst b, DeBruijn b) => NamesT (TCMT IO) b)
        -> NamesT (TCMT IO) (Tele (Dom Type)))
    -> NamesT (TCMT IO) (Abs (Tele (Dom Type)))
    forall a b. (a -> b) -> a -> b
    $ \ forall b. (Subst b, DeBruijn b) => NamesT (TCMT IO) b
    i -> NamesT (TCMT IO) (AbsN (Tele (Dom Type)))
    -> [NamesT (TCMT IO) (SubstArg (Tele (Dom Type)))]
    -> NamesT (TCMT IO) (Tele (Dom Type))
    forall (m :: * -> *) a.
    (Monad m, Subst a) =>
    NamesT m (AbsN a) -> [NamesT m (SubstArg a)] -> NamesT m a
    applyN NamesT (TCMT IO) (AbsN (Tele (Dom Type)))
    xTel ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
    -> [NamesT (TCMT IO) Term] -> [NamesT (TCMT IO) Term]
    forall a b. (a -> b) -> [a] -> [b]
    map (NamesT (TCMT IO) Term
    -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <@> NamesT (TCMT IO) Term
    -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
    forall {m :: * -> *}.
    (HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
    NamesT m Term -> NamesT m Term -> NamesT m Term
    max NamesT (TCMT IO) Term
    forall b. (Subst b, DeBruijn b) => NamesT (TCMT IO) b
    i NamesT (TCMT IO) Term
    forall b. (Subst b, DeBruijn b) => NamesT (TCMT IO) b
    j) [NamesT (TCMT IO) Term]
    delta)
                           let theLeft :: NamesT (TCMT IO) [Term]
    theLeft = NamesT (TCMT IO) (Abs [Term]) -> NamesT (TCMT IO) [Term]
    forall (m :: * -> *).
    Monad m =>
    NamesT m (Abs [Term]) -> NamesT m [Term]
    lamTel (NamesT (TCMT IO) (Abs [Term]) -> NamesT (TCMT IO) [Term])
    -> NamesT (TCMT IO) (Abs [Term]) -> NamesT (TCMT IO) [Term]
    forall a b. (a -> b) -> a -> b
    $ String
    -> ((forall b. (Subst b, DeBruijn b) => NamesT (TCMT IO) b)
        -> NamesT (TCMT IO) [Term])
    -> NamesT (TCMT IO) (Abs [Term])
    forall (m :: * -> *) a.
    Monad m =>
    String
    -> ((forall b. (Subst b, DeBruijn b) => NamesT m b) -> NamesT m a)
    -> NamesT m (Abs a)
    bind String
    "i" (((forall b. (Subst b, DeBruijn b) => NamesT (TCMT IO) b)
      -> NamesT (TCMT IO) [Term])
     -> NamesT (TCMT IO) (Abs [Term]))
    -> ((forall b. (Subst b, DeBruijn b) => NamesT (TCMT IO) b)
        -> NamesT (TCMT IO) [Term])
    -> NamesT (TCMT IO) (Abs [Term])
    forall a b. (a -> b) -> a -> b
    $ \ forall b. (Subst b, DeBruijn b) => NamesT (TCMT IO) b
    i -> do
                                 as01 <- (Arg Term -> NamesT (TCMT IO) (NamesT (TCMT IO) Term))
    -> [Arg Term] -> NamesT (TCMT IO) [NamesT (TCMT IO) Term]
    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 (Term -> NamesT (TCMT IO) (NamesT (TCMT IO) Term)
    forall (m :: * -> *) a.
    (Monad m, Subst a) =>
    a -> NamesT m (NamesT m a)
    open (Term -> NamesT (TCMT IO) (NamesT (TCMT IO) Term))
    -> (Arg Term -> Term)
    -> Arg Term
    -> NamesT (TCMT IO) (NamesT (TCMT IO) Term)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Arg Term -> Term
    forall e. Arg e -> e
    unArg) ([Arg Term] -> NamesT (TCMT IO) [NamesT (TCMT IO) Term])
    -> NamesT (TCMT IO) [Arg Term]
    -> NamesT (TCMT IO) [NamesT (TCMT IO) Term]
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< (Abs [Arg Term] -> Term -> [Arg Term]
    Abs [Arg Term] -> SubstArg [Arg Term] -> [Arg Term]
    forall a. Subst a => Abs a -> SubstArg a -> a
    absApp (Abs [Arg Term] -> Term -> [Arg Term])
    -> NamesT (TCMT IO) (Abs [Arg Term])
    -> NamesT (TCMT IO) (Term -> [Arg Term])
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> NamesT (TCMT IO) (Abs [Arg Term])
    as01 NamesT (TCMT IO) (Term -> [Arg Term])
    -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) [Arg Term]
    forall a b.
    NamesT (TCMT IO) (a -> b)
    -> NamesT (TCMT IO) a -> NamesT (TCMT IO) b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> NamesT (TCMT IO) Term
    forall b. (Subst b, DeBruijn b) => NamesT (TCMT IO) b
    i)
                                 con_ixs `applyN` (map (<@> i) delta ++ as01)
                           theLeft <- (Term -> NamesT (TCMT IO) (NamesT (TCMT IO) Term))
    -> [Term] -> NamesT (TCMT IO) [NamesT (TCMT IO) Term]
    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 Term -> NamesT (TCMT IO) (NamesT (TCMT IO) Term)
    forall (m :: * -> *) a.
    (Monad m, Subst a) =>
    a -> NamesT m (NamesT m a)
    open ([Term] -> NamesT (TCMT IO) [NamesT (TCMT IO) Term])
    -> NamesT (TCMT IO) [Term]
    -> NamesT (TCMT IO) [NamesT (TCMT IO) Term]
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< NamesT (TCMT IO) [Term]
    theLeft
                           theRight <- (mapM open =<<) $ lamTel $ bind "i" $ \ forall b. (Subst b, DeBruijn b) => NamesT (TCMT IO) b
    i -> do
                             NamesT (TCMT IO) (AbsN [Term])
    con_ixs NamesT (TCMT IO) (AbsN [Term])
    -> [NamesT (TCMT IO) (SubstArg [Term])] -> NamesT (TCMT IO) [Term]
    forall (m :: * -> *) a.
    (Monad m, Subst a) =>
    NamesT m (AbsN a) -> [NamesT m (SubstArg a)] -> NamesT m a
    `applyN` ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
    -> [NamesT (TCMT IO) Term] -> [NamesT (TCMT IO) Term]
    forall a b. (a -> b) -> [a] -> [b]
    map (NamesT (TCMT IO) Term
    -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <@> Term -> NamesT (TCMT IO) Term
    forall a. a -> NamesT (TCMT IO) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Term
    io) [NamesT (TCMT IO) Term]
    delta [NamesT (TCMT IO) Term]
    -> [NamesT (TCMT IO) Term] -> [NamesT (TCMT IO) Term]
    forall a. [a] -> [a] -> [a]
    ++ [NamesT (TCMT IO) Term]
    as1)

                           trx' <- transpPathPTel' theTel x theRight phi theLeft
                           let args = ([Arg Term] -> [Arg Term] -> [Arg Term])
    -> NamesT (TCMT IO) [Arg Term]
    -> NamesT (TCMT IO) [Arg Term]
    -> NamesT (TCMT IO) [Arg Term]
    forall (m :: * -> *) a1 a2 r.
    Monad m =>
    (a1 -> a2 -> r) -> m a1 -> m a2 -> m r
    liftM2 [Arg Term] -> [Arg Term] -> [Arg Term]
    forall a. [a] -> [a] -> [a]
    (++) ((Arg Term -> Arg Term) -> [Arg Term] -> [Arg Term]
    forall a b. (a -> b) -> [a] -> [b]
    map (Hiding -> Arg Term -> Arg Term
    forall a. LensHiding a => Hiding -> a -> a
    setHiding Hiding
    Hidden) ([Arg Term] -> [Arg Term])
    -> NamesT (TCMT IO) [Arg Term] -> NamesT (TCMT IO) [Arg Term]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> NamesT (TCMT IO) Term -> NamesT (TCMT IO) [Arg Term]
    deltaArg (Term -> NamesT (TCMT IO) Term
    forall a. a -> NamesT (TCMT IO) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Term
    io)) ([Arg Term]
    -> (Arg Term -> NamesT (TCMT IO) (Arg Term))
    -> NamesT (TCMT IO) [Arg Term]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    t a -> (a -> m b) -> m (t b)
    forM [Arg Term]
    trx' ((Arg Term -> NamesT (TCMT IO) (Arg Term))
     -> NamesT (TCMT IO) [Arg Term])
    -> (Arg Term -> NamesT (TCMT IO) (Arg Term))
    -> NamesT (TCMT IO) [Arg Term]
    forall a b. (a -> b) -> a -> b
    $ \ Arg Term
    q' -> do
                                                                           q' <- Arg Term -> NamesT (TCMT IO) (NamesT (TCMT IO) (Arg Term))
    forall (m :: * -> *) a.
    (Monad m, Subst a) =>
    a -> NamesT m (NamesT m a)
    open Arg Term
    q'
                                                                           argLam "i" $ \ forall b. (Subst b, DeBruijn b) => NamesT (TCMT IO) b
    i -> NamesT (TCMT IO) (Arg Term)
    q' NamesT (TCMT IO) (Arg Term)
    -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) (Arg Term)
    forall {m :: * -> *} {b} {f :: * -> *}.
    (Monad m, Apply b, Functor f) =>
    m (f b) -> m Term -> m (f b)
    `argApp` NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
    forall {m :: * -> *}.
    (HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
    NamesT m Term -> NamesT m Term
    neg NamesT (TCMT IO) Term
    forall b. (Subst b, DeBruijn b) => NamesT (TCMT IO) b
    i)
                           (apply (Def trX []) <$> args) <@> phi <@> cas1

              if null boundary then base else do

              -- We have to correct the boundary for path constructors.

              -- bline : Abs I ([phi] → ty)
              let blineFace = NamesT (TCMT IO) (AbsN Term)
    -> [NamesT (TCMT IO) (SubstArg Term)] -> NamesT (TCMT IO) Term
    forall (m :: * -> *) a.
    (Monad m, Subst a) =>
    NamesT m (AbsN a) -> [NamesT m (SubstArg a)] -> NamesT m a
    applyN NamesT (TCMT IO) (AbsN Term)
    bsysFace ([NamesT (TCMT IO) (SubstArg Term)] -> NamesT (TCMT IO) Term)
    -> [NamesT (TCMT IO) (SubstArg Term)] -> NamesT (TCMT IO) Term
    forall a b. (a -> b) -> a -> b
    $ (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
    -> [NamesT (TCMT IO) Term] -> [NamesT (TCMT IO) Term]
    forall a b. (a -> b) -> [a] -> [b]
    map (NamesT (TCMT IO) Term
    -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <@> Term -> NamesT (TCMT IO) Term
    forall a. a -> NamesT (TCMT IO) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Term
    io) [NamesT (TCMT IO) Term]
    delta [NamesT (TCMT IO) Term]
    -> [NamesT (TCMT IO) Term] -> [NamesT (TCMT IO) Term]
    forall a. [a] -> [a] -> [a]
    ++ [NamesT (TCMT IO) Term]
    as1
              let bline = do
                    let theTel :: NamesT (TCMT IO) (Abs (Abs (Tele (Dom Type))))
    theTel = String
    -> ((forall b. (Subst b, DeBruijn b) => NamesT (TCMT IO) b)
        -> NamesT (TCMT IO) (Abs (Tele (Dom Type))))
    -> NamesT (TCMT IO) (Abs (Abs (Tele (Dom Type))))
    forall (m :: * -> *) a.
    Monad m =>
    String
    -> ((forall b. (Subst b, DeBruijn b) => NamesT m b) -> NamesT m a)
    -> NamesT m (Abs a)
    bind String
    "j" (((forall b. (Subst b, DeBruijn b) => NamesT (TCMT IO) b)
      -> NamesT (TCMT IO) (Abs (Tele (Dom Type))))
     -> NamesT (TCMT IO) (Abs (Abs (Tele (Dom Type)))))
    -> ((forall b. (Subst b, DeBruijn b) => NamesT (TCMT IO) b)
        -> NamesT (TCMT IO) (Abs (Tele (Dom Type))))
    -> NamesT (TCMT IO) (Abs (Abs (Tele (Dom Type))))
    forall a b. (a -> b) -> a -> b
    $ \ forall b. (Subst b, DeBruijn b) => NamesT (TCMT IO) b
    j -> String
    -> ((forall b. (Subst b, DeBruijn b) => NamesT (TCMT IO) b)
        -> NamesT (TCMT IO) (Tele (Dom Type)))
    -> NamesT (TCMT IO) (Abs (Tele (Dom Type)))
    forall (m :: * -> *) a.
    Monad m =>
    String
    -> ((forall b. (Subst b, DeBruijn b) => NamesT m b) -> NamesT m a)
    -> NamesT m (Abs a)
    bind String
    "i" (((forall b. (Subst b, DeBruijn b) => NamesT (TCMT IO) b)
      -> NamesT (TCMT IO) (Tele (Dom Type)))
     -> NamesT (TCMT IO) (Abs (Tele (Dom Type))))
    -> ((forall b. (Subst b, DeBruijn b) => NamesT (TCMT IO) b)
        -> NamesT (TCMT IO) (Tele (Dom Type)))
    -> NamesT (TCMT IO) (Abs (Tele (Dom Type)))
    forall a b. (a -> b) -> a -> b
    $ \ forall b. (Subst b, DeBruijn b) => NamesT (TCMT IO) b
    i -> NamesT (TCMT IO) (AbsN (Tele (Dom Type)))
    -> [NamesT (TCMT IO) (SubstArg (Tele (Dom Type)))]
    -> NamesT (TCMT IO) (Tele (Dom Type))
    forall (m :: * -> *) a.
    (Monad m, Subst a) =>
    NamesT m (AbsN a) -> [NamesT m (SubstArg a)] -> NamesT m a
    applyN NamesT (TCMT IO) (AbsN (Tele (Dom Type)))
    xTel ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
    -> [NamesT (TCMT IO) Term] -> [NamesT (TCMT IO) Term]
    forall a b. (a -> b) -> [a] -> [b]
    map (NamesT (TCMT IO) Term
    -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <@> NamesT (TCMT IO) Term
    -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
    forall {m :: * -> *}.
    (HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
    NamesT m Term -> NamesT m Term -> NamesT m Term
    max NamesT (TCMT IO) Term
    forall b. (Subst b, DeBruijn b) => NamesT (TCMT IO) b
    i NamesT (TCMT IO) Term
    forall b. (Subst b, DeBruijn b) => NamesT (TCMT IO) b
    j) [NamesT (TCMT IO) Term]
    delta)
                    let theLeft :: NamesT (TCMT IO) [Term]
    theLeft = NamesT (TCMT IO) (Abs [Term]) -> NamesT (TCMT IO) [Term]
    forall (m :: * -> *).
    Monad m =>
    NamesT m (Abs [Term]) -> NamesT m [Term]
    lamTel (NamesT (TCMT IO) (Abs [Term]) -> NamesT (TCMT IO) [Term])
    -> NamesT (TCMT IO) (Abs [Term]) -> NamesT (TCMT IO) [Term]
    forall a b. (a -> b) -> a -> b
    $ String
    -> ((forall b. (Subst b, DeBruijn b) => NamesT (TCMT IO) b)
        -> NamesT (TCMT IO) [Term])
    -> NamesT (TCMT IO) (Abs [Term])
    forall (m :: * -> *) a.
    Monad m =>
    String
    -> ((forall b. (Subst b, DeBruijn b) => NamesT m b) -> NamesT m a)
    -> NamesT m (Abs a)
    bind String
    "i" (((forall b. (Subst b, DeBruijn b) => NamesT (TCMT IO) b)
      -> NamesT (TCMT IO) [Term])
     -> NamesT (TCMT IO) (Abs [Term]))
    -> ((forall b. (Subst b, DeBruijn b) => NamesT (TCMT IO) b)
        -> NamesT (TCMT IO) [Term])
    -> NamesT (TCMT IO) (Abs [Term])
    forall a b. (a -> b) -> a -> b
    $ \ forall b. (Subst b, DeBruijn b) => NamesT (TCMT IO) b
    i -> do
                          as01 <- (Arg Term -> NamesT (TCMT IO) (NamesT (TCMT IO) Term))
    -> [Arg Term] -> NamesT (TCMT IO) [NamesT (TCMT IO) Term]
    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 (Term -> NamesT (TCMT IO) (NamesT (TCMT IO) Term)
    forall (m :: * -> *) a.
    (Monad m, Subst a) =>
    a -> NamesT m (NamesT m a)
    open (Term -> NamesT (TCMT IO) (NamesT (TCMT IO) Term))
    -> (Arg Term -> Term)
    -> Arg Term
    -> NamesT (TCMT IO) (NamesT (TCMT IO) Term)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Arg Term -> Term
    forall e. Arg e -> e
    unArg) ([Arg Term] -> NamesT (TCMT IO) [NamesT (TCMT IO) Term])
    -> NamesT (TCMT IO) [Arg Term]
    -> NamesT (TCMT IO) [NamesT (TCMT IO) Term]
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< (Abs [Arg Term] -> Term -> [Arg Term]
    Abs [Arg Term] -> SubstArg [Arg Term] -> [Arg Term]
    forall a. Subst a => Abs a -> SubstArg a -> a
    absApp (Abs [Arg Term] -> Term -> [Arg Term])
    -> NamesT (TCMT IO) (Abs [Arg Term])
    -> NamesT (TCMT IO) (Term -> [Arg Term])
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> NamesT (TCMT IO) (Abs [Arg Term])
    as01 NamesT (TCMT IO) (Term -> [Arg Term])
    -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) [Arg Term]
    forall a b.
    NamesT (TCMT IO) (a -> b)
    -> NamesT (TCMT IO) a -> NamesT (TCMT IO) b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> NamesT (TCMT IO) Term
    forall b. (Subst b, DeBruijn b) => NamesT (TCMT IO) b
    i)
                          con_ixs `applyN` (map (<@> i) delta ++ as01)
                    theLeft <- (Term -> NamesT (TCMT IO) (NamesT (TCMT IO) Term))
    -> [Term] -> NamesT (TCMT IO) [NamesT (TCMT IO) Term]
    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 Term -> NamesT (TCMT IO) (NamesT (TCMT IO) Term)
    forall (m :: * -> *) a.
    (Monad m, Subst a) =>
    a -> NamesT m (NamesT m a)
    open ([Term] -> NamesT (TCMT IO) [NamesT (TCMT IO) Term])
    -> NamesT (TCMT IO) [Term]
    -> NamesT (TCMT IO) [NamesT (TCMT IO) Term]
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< NamesT (TCMT IO) [Term]
    theLeft
                    theRight <- (mapM open =<<) $ lamTel $ bind "i" $ \ forall b. (Subst b, DeBruijn b) => NamesT (TCMT IO) b
    i -> do
                      NamesT (TCMT IO) (AbsN [Term])
    con_ixs NamesT (TCMT IO) (AbsN [Term])
    -> [NamesT (TCMT IO) (SubstArg [Term])] -> NamesT (TCMT IO) [Term]
    forall (m :: * -> *) a.
    (Monad m, Subst a) =>
    NamesT m (AbsN a) -> [NamesT m (SubstArg a)] -> NamesT m a
    `applyN` ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
    -> [NamesT (TCMT IO) Term] -> [NamesT (TCMT IO) Term]
    forall a b. (a -> b) -> [a] -> [b]
    map (NamesT (TCMT IO) Term
    -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <@> Term -> NamesT (TCMT IO) Term
    forall a. a -> NamesT (TCMT IO) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Term
    io) [NamesT (TCMT IO) Term]
    delta [NamesT (TCMT IO) Term]
    -> [NamesT (TCMT IO) Term] -> [NamesT (TCMT IO) Term]
    forall a. [a] -> [a] -> [a]
    ++ [NamesT (TCMT IO) Term]
    as1)
                    let q2_f = String
    -> ((forall b. (Subst b, DeBruijn b) => NamesT (TCMT IO) b)
        -> NamesT (TCMT IO) [Term])
    -> NamesT (TCMT IO) (Abs [Term])
    forall (m :: * -> *) a.
    Monad m =>
    String
    -> ((forall b. (Subst b, DeBruijn b) => NamesT m b) -> NamesT m a)
    -> NamesT m (Abs a)
    bind String
    "i" (((forall b. (Subst b, DeBruijn b) => NamesT (TCMT IO) b)
      -> NamesT (TCMT IO) [Term])
     -> NamesT (TCMT IO) (Abs [Term]))
    -> ((forall b. (Subst b, DeBruijn b) => NamesT (TCMT IO) b)
        -> NamesT (TCMT IO) [Term])
    -> NamesT (TCMT IO) (Abs [Term])
    forall a b. (a -> b) -> a -> b
    $ \ forall b. (Subst b, DeBruijn b) => NamesT (TCMT IO) b
    i -> (Arg Term -> Term) -> [Arg Term] -> [Term]
    forall a b. (a -> b) -> [a] -> [b]
    map Arg Term -> Term
    forall e. Arg e -> e
    unArg ([Arg Term] -> [Term])
    -> NamesT (TCMT IO) [Arg Term] -> NamesT (TCMT IO) [Term]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> NamesT (TCMT IO) (Abs (Abs (Tele (Dom Type))))
    -> [NamesT (TCMT IO) Term]
    -> [NamesT (TCMT IO) Term]
    -> NamesT (TCMT IO) Term
    -> [NamesT (TCMT IO) Term]
    -> NamesT (TCMT IO) Term
    -> NamesT (TCMT IO) [Arg Term]
    trFillPathPTel' NamesT (TCMT IO) (Abs (Abs (Tele (Dom Type))))
    theTel [NamesT (TCMT IO) Term]
    x [NamesT (TCMT IO) Term]
    theRight NamesT (TCMT IO) Term
    phi [NamesT (TCMT IO) Term]
    theLeft NamesT (TCMT IO) Term
    forall b. (Subst b, DeBruijn b) => NamesT (TCMT IO) b
    i

                    lam "i" $ \ NamesT (TCMT IO) Term
    i -> do
                    let v0 :: NamesT (TCMT IO) Term
    v0 = do
                         as01 <- (Arg Term -> NamesT (TCMT IO) (NamesT (TCMT IO) Term))
    -> [Arg Term] -> NamesT (TCMT IO) [NamesT (TCMT IO) Term]
    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 (Term -> NamesT (TCMT IO) (NamesT (TCMT IO) Term)
    forall (m :: * -> *) a.
    (Monad m, Subst a) =>
    a -> NamesT m (NamesT m a)
    open (Term -> NamesT (TCMT IO) (NamesT (TCMT IO) Term))
    -> (Arg Term -> Term)
    -> Arg Term
    -> NamesT (TCMT IO) (NamesT (TCMT IO) Term)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Arg Term -> Term
    forall e. Arg e -> e
    unArg) ([Arg Term] -> NamesT (TCMT IO) [NamesT (TCMT IO) Term])
    -> NamesT (TCMT IO) [Arg Term]
    -> NamesT (TCMT IO) [NamesT (TCMT IO) Term]
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< (Abs [Arg Term] -> Term -> [Arg Term]
    Abs [Arg Term] -> SubstArg [Arg Term] -> [Arg Term]
    forall a. Subst a => Abs a -> SubstArg a -> a
    absApp (Abs [Arg Term] -> Term -> [Arg Term])
    -> NamesT (TCMT IO) (Abs [Arg Term])
    -> NamesT (TCMT IO) (Term -> [Arg Term])
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> NamesT (TCMT IO) (Abs [Arg Term])
    as01 NamesT (TCMT IO) (Term -> [Arg Term])
    -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) [Arg Term]
    forall a b.
    NamesT (TCMT IO) (a -> b)
    -> NamesT (TCMT IO) a -> NamesT (TCMT IO) b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> NamesT (TCMT IO) Term
    i)
                         applyN bsys $ map (<@> i) delta ++ as01
                    let squeezedv0 :: NamesT (TCMT IO) Term
    squeezedv0 = String
    -> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
    -> NamesT (TCMT IO) Term
    forall (m :: * -> *).
    Monad m =>
    String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
    ilam String
    "o" ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
     -> NamesT (TCMT IO) Term)
    -> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
    -> NamesT (TCMT IO) Term
    forall a b. (a -> b) -> a -> b
    $ \ NamesT (TCMT IO) Term
    o -> do
                          let
                            delta_f :: [NamesT TCM Term]
                            delta_f :: [NamesT (TCMT IO) Term]
    delta_f = [NamesT (TCMT IO) Term]
    -> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
    -> [NamesT (TCMT IO) Term]
    forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
    for [NamesT (TCMT IO) Term]
    delta ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
     -> [NamesT (TCMT IO) Term])
    -> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
    -> [NamesT (TCMT IO) Term]
    forall a b. (a -> b) -> a -> b
    $ \ NamesT (TCMT IO) Term
    p -> String
    -> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
    -> NamesT (TCMT IO) Term
    forall (m :: * -> *).
    Monad m =>
    String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
    lam String
    "j" ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
     -> NamesT (TCMT IO) Term)
    -> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
    -> NamesT (TCMT IO) Term
    forall a b. (a -> b) -> a -> b
    $ \ NamesT (TCMT IO) Term
    j -> NamesT (TCMT IO) Term
    p NamesT (TCMT IO) Term
    -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <@> (NamesT (TCMT IO) Term
    j NamesT (TCMT IO) Term
    -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
    forall {m :: * -> *}.
    (HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
    NamesT m Term -> NamesT m Term -> NamesT m Term
    `max` NamesT (TCMT IO) Term
    i)
                          x_f <- ((Term -> NamesT (TCMT IO) (NamesT (TCMT IO) Term))
    -> [Term] -> NamesT (TCMT IO) [NamesT (TCMT IO) Term]
    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 Term -> NamesT (TCMT IO) (NamesT (TCMT IO) Term)
    forall (m :: * -> *) a.
    (Monad m, Subst a) =>
    a -> NamesT m (NamesT m a)
    open ([Term] -> NamesT (TCMT IO) [NamesT (TCMT IO) Term])
    -> NamesT (TCMT IO) [Term]
    -> NamesT (TCMT IO) [NamesT (TCMT IO) Term]
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<<) (NamesT (TCMT IO) [Term]
     -> NamesT (TCMT IO) [NamesT (TCMT IO) Term])
    -> NamesT (TCMT IO) [Term]
    -> NamesT (TCMT IO) [NamesT (TCMT IO) Term]
    forall a b. (a -> b) -> a -> b
    $ NamesT (TCMT IO) (Abs [Term]) -> NamesT (TCMT IO) [Term]
    forall (m :: * -> *).
    Monad m =>
    NamesT m (Abs [Term]) -> NamesT m [Term]
    lamTel (NamesT (TCMT IO) (Abs [Term]) -> NamesT (TCMT IO) [Term])
    -> NamesT (TCMT IO) (Abs [Term]) -> NamesT (TCMT IO) [Term]
    forall a b. (a -> b) -> a -> b
    $ String
    -> ((forall b. (Subst b, DeBruijn b) => NamesT (TCMT IO) b)
        -> NamesT (TCMT IO) [Term])
    -> NamesT (TCMT IO) (Abs [Term])
    forall (m :: * -> *) a.
    Monad m =>
    String
    -> ((forall b. (Subst b, DeBruijn b) => NamesT m b) -> NamesT m a)
    -> NamesT m (Abs a)
    bind String
    "j" (((forall b. (Subst b, DeBruijn b) => NamesT (TCMT IO) b)
      -> NamesT (TCMT IO) [Term])
     -> NamesT (TCMT IO) (Abs [Term]))
    -> ((forall b. (Subst b, DeBruijn b) => NamesT (TCMT IO) b)
        -> NamesT (TCMT IO) [Term])
    -> NamesT (TCMT IO) (Abs [Term])
    forall a b. (a -> b) -> a -> b
    $ \ forall b. (Subst b, DeBruijn b) => NamesT (TCMT IO) b
    j ->
                                     (Abs [Term] -> Term -> [Term]
    Abs [Term] -> SubstArg [Term] -> [Term]
    forall a. Subst a => Abs a -> SubstArg a -> a
    absApp (Abs [Term] -> Term -> [Term])
    -> NamesT (TCMT IO) (Abs [Term])
    -> NamesT (TCMT IO) (Term -> [Term])
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> NamesT (TCMT IO) (Abs [Term])
    q2_f NamesT (TCMT IO) (Term -> [Term])
    -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) [Term]
    forall a b.
    NamesT (TCMT IO) (a -> b)
    -> NamesT (TCMT IO) a -> NamesT (TCMT IO) b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> NamesT (TCMT IO) Term
    forall b. (Subst b, DeBruijn b) => NamesT (TCMT IO) b
    j) NamesT (TCMT IO) [Term]
    -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) [Term]
    forall (m :: * -> *).
    Monad m =>
    NamesT m [Term] -> NamesT m Term -> NamesT m [Term]
    `appTel` NamesT (TCMT IO) Term
    i
                          trD `applyN` delta_f `applyN` x_f `applyN` [phi `max` i, v0 <..> o]

                    Maybe QName
    -> NamesT (TCMT IO) Term
    -> (QName -> NamesT (TCMT IO) Term)
    -> NamesT (TCMT IO) Term
    forall a b. Maybe a -> b -> (a -> b) -> b
    caseMaybe Maybe QName
    mtrX NamesT (TCMT IO) Term
    squeezedv0 ((QName -> NamesT (TCMT IO) Term) -> NamesT (TCMT IO) Term)
    -> (QName -> NamesT (TCMT IO) Term) -> NamesT (TCMT IO) Term
    forall a b. (a -> b) -> a -> b
    $ \ QName
    trX -> String
    -> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
    -> NamesT (TCMT IO) Term
    forall (m :: * -> *).
    Monad m =>
    String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
    ilam String
    "o" ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
     -> NamesT (TCMT IO) Term)
    -> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
    -> NamesT (TCMT IO) Term
    forall a b. (a -> b) -> a -> b
    $ \ NamesT (TCMT IO) Term
    o -> do
                      q2 <- NamesT (TCMT IO) (Abs (Abs (Tele (Dom Type))))
    -> [NamesT (TCMT IO) Term]
    -> [NamesT (TCMT IO) Term]
    -> NamesT (TCMT IO) Term
    -> [NamesT (TCMT IO) Term]
    -> NamesT (TCMT IO) [Arg Term]
    transpPathPTel' NamesT (TCMT IO) (Abs (Abs (Tele (Dom Type))))
    theTel [NamesT (TCMT IO) Term]
    x [NamesT (TCMT IO) Term]
    theRight NamesT (TCMT IO) Term
    phi [NamesT (TCMT IO) Term]
    theLeft
                      let args = ([Arg Term] -> [Arg Term] -> [Arg Term])
    -> NamesT (TCMT IO) [Arg Term]
    -> NamesT (TCMT IO) [Arg Term]
    -> NamesT (TCMT IO) [Arg Term]
    forall (m :: * -> *) a1 a2 r.
    Monad m =>
    (a1 -> a2 -> r) -> m a1 -> m a2 -> m r
    liftM2 [Arg Term] -> [Arg Term] -> [Arg Term]
    forall a. [a] -> [a] -> [a]
    (++) ((Arg Term -> Arg Term) -> [Arg Term] -> [Arg Term]
    forall a b. (a -> b) -> [a] -> [b]
    map (Hiding -> Arg Term -> Arg Term
    forall a. LensHiding a => Hiding -> a -> a
    setHiding Hiding
    Hidden) ([Arg Term] -> [Arg Term])
    -> NamesT (TCMT IO) [Arg Term] -> NamesT (TCMT IO) [Arg Term]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> NamesT (TCMT IO) Term -> NamesT (TCMT IO) [Arg Term]
    deltaArg (Term -> NamesT (TCMT IO) Term
    forall a. a -> NamesT (TCMT IO) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Term
    io))
                                             ([Arg Term]
    -> (Arg Term -> NamesT (TCMT IO) (Arg Term))
    -> NamesT (TCMT IO) [Arg Term]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    t a -> (a -> m b) -> m (t b)
    forM [Arg Term]
    q2 ((Arg Term -> NamesT (TCMT IO) (Arg Term))
     -> NamesT (TCMT IO) [Arg Term])
    -> (Arg Term -> NamesT (TCMT IO) (Arg Term))
    -> NamesT (TCMT IO) [Arg Term]
    forall a b. (a -> b) -> a -> b
    $ \ Arg Term
    q' -> do
                                                q' <- Arg Term -> NamesT (TCMT IO) (NamesT (TCMT IO) (Arg Term))
    forall (m :: * -> *) a.
    (Monad m, Subst a) =>
    a -> NamesT m (NamesT m a)
    open Arg Term
    q'
                                                argLam "j" $ \ forall b. (Subst b, DeBruijn b) => NamesT (TCMT IO) b
    j -> NamesT (TCMT IO) (Arg Term)
    q' NamesT (TCMT IO) (Arg Term)
    -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) (Arg Term)
    forall {m :: * -> *} {b} {f :: * -> *}.
    (Monad m, Apply b, Functor f) =>
    m (f b) -> m Term -> m (f b)
    `argApp` (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
    forall {m :: * -> *}.
    (HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
    NamesT m Term -> NamesT m Term
    neg NamesT (TCMT IO) Term
    forall b. (Subst b, DeBruijn b) => NamesT (TCMT IO) b
    j NamesT (TCMT IO) Term
    -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
    forall {m :: * -> *}.
    (HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
    NamesT m Term -> NamesT m Term -> NamesT m Term
    `min` NamesT (TCMT IO) Term
    i))

                      (apply (Def trX []) <$> args) <@> (neg i `max` phi) <@> (squeezedv0 <..> o)
              hcomp
                 rhsTy
                 [(blineFace,lam "i" $ \ NamesT (TCMT IO) Term
    i -> NamesT (TCMT IO) Term
    bline NamesT (TCMT IO) Term
    -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <@> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
    forall {m :: * -> *}.
    (HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
    NamesT m Term -> NamesT m Term
    neg NamesT (TCMT IO) Term
    i))
                 ,(phi      ,lam "i" $ \ NamesT (TCMT IO) Term
    _ -> String
    -> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
    -> NamesT (TCMT IO) Term
    forall (m :: * -> *).
    Monad m =>
    String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
    ilam String
    "o" ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
     -> NamesT (TCMT IO) Term)
    -> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
    -> NamesT (TCMT IO) Term
    forall a b. (a -> b) -> a -> b
    $ \ NamesT (TCMT IO) Term
    _ -> NamesT (TCMT IO) Term
    orig)
                 ]
                 base

            let
              (ps,rhsTy,rhs) = unAbsN $ unAbsN $ unAbsN $ unAbsN $ res
            mkClause gamma ps rhsTy rhs
      where
        mkClause :: Tele (Dom Type)
    -> [Arg (Named_ (Pattern' DBPatVar))] -> Type -> Term -> m Clause
    mkClause Tele (Dom Type)
    gamma [Arg (Named_ (Pattern' DBPatVar))]
    ps Type
    rhsTy Term
    rhs = do
          let
            c :: Clause
    c = Clause
                { clauseTel :: Tele (Dom Type)
    clauseTel         = Tele (Dom Type)
    gamma
                , clauseType :: Maybe (Arg Type)
    clauseType        = Arg Type -> Maybe (Arg Type)
    forall a. a -> Maybe a
    Just (Arg Type -> Maybe (Arg Type))
    -> (Type -> Arg Type) -> Type -> Maybe (Arg Type)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Type -> Arg Type
    forall e. e -> Arg e
    argN (Type -> Maybe (Arg Type)) -> Type -> Maybe (Arg Type)
    forall a b. (a -> b) -> a -> b
    $ Type
    rhsTy
                , namedClausePats :: [Arg (Named_ (Pattern' DBPatVar))]
    namedClausePats   = [Arg (Named_ (Pattern' DBPatVar))]
    ps
                , clauseFullRange :: Range
    clauseFullRange   = Range
    forall a. Range' a
    noRange
                , clauseLHSRange :: Range
    clauseLHSRange    = Range
    forall a. Range' a
    noRange
                , clauseCatchall :: Catchall
    clauseCatchall    = Catchall
    forall a. Null a => a
    empty
                , clauseBody :: Maybe Term
    clauseBody        = Term -> Maybe Term
    forall a. a -> Maybe a
    Just (Term -> Maybe Term) -> Term -> Maybe Term
    forall a b. (a -> b) -> a -> b
    $ Term
    rhs
                , clauseRecursive :: Maybe Bool
    clauseRecursive   = Maybe Bool
    forall a. Maybe a
    Nothing
                -- it is indirectly recursive through transp, does it count?
                , clauseUnreachable :: Maybe Bool
    clauseUnreachable = Bool -> Maybe Bool
    forall a. a -> Maybe a
    Just Bool
    False
                , clauseEllipsis :: ExpandedEllipsis
    clauseEllipsis    = ExpandedEllipsis
    NoEllipsis
                , clauseWhereModule :: Maybe ModuleName
    clauseWhereModule = Maybe ModuleName
    forall a. Maybe a
    Nothing
                }
          String -> Nat -> TCMT IO Doc -> m ()
    forall (m :: * -> *).
    MonadDebug m =>
    String -> Nat -> TCMT IO Doc -> m ()
    reportSDoc String
    "tc.data.transp.con" Nat
    20 (TCMT IO Doc -> m ()) -> TCMT IO Doc -> m ()
    forall a b. (a -> b) -> a -> b
    $
            TCMT IO Doc
    "gamma:" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> Tele (Dom Type) -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    forall (m :: * -> *). MonadPretty m => Tele (Dom Type) -> m Doc
    prettyTCM Tele (Dom Type)
    gamma
          String -> Nat -> TCMT IO Doc -> m ()
    forall (m :: * -> *).
    MonadDebug m =>
    String -> Nat -> TCMT IO Doc -> m ()
    reportSDoc String
    "tc.data.transp.con" Nat
    20 (TCMT IO Doc -> m ()) -> TCMT IO Doc -> m ()
    forall a b. (a -> b) -> a -> b
    $ Tele (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 =>
    Tele (Dom Type) -> m a -> m a
    addContext Tele (Dom Type)
    gamma (TCMT IO Doc -> TCMT IO Doc) -> TCMT IO Doc -> TCMT IO Doc
    forall a b. (a -> b) -> a -> b
    $
            TCMT IO Doc
    "ps   :" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> [Elim' Term] -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    forall (m :: * -> *). MonadPretty m => [Elim' Term] -> m Doc
    prettyTCM ([Arg (Named_ (Pattern' DBPatVar))] -> [Elim' Term]
    patternsToElims [Arg (Named_ (Pattern' DBPatVar))]
    ps)
          String -> Nat -> TCMT IO Doc -> m ()
    forall (m :: * -> *).
    MonadDebug m =>
    String -> Nat -> TCMT IO Doc -> m ()
    reportSDoc String
    "tc.data.transp.con" Nat
    20 (TCMT IO Doc -> m ()) -> TCMT IO Doc -> m ()
    forall a b. (a -> b) -> a -> b
    $ Tele (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 =>
    Tele (Dom Type) -> m a -> m a
    addContext Tele (Dom Type)
    gamma (TCMT IO Doc -> TCMT IO Doc) -> TCMT IO Doc -> TCMT IO Doc
    forall a b. (a -> b) -> a -> b
    $
            TCMT IO Doc
    "type :" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> Type -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    forall (m :: * -> *). MonadPretty m => Type -> m Doc
    prettyTCM Type
    rhsTy
          String -> Nat -> TCMT IO Doc -> m ()
    forall (m :: * -> *).
    MonadDebug m =>
    String -> Nat -> TCMT IO Doc -> m ()
    reportSDoc String
    "tc.data.transp.con" Nat
    20 (TCMT IO Doc -> m ()) -> TCMT IO Doc -> m ()
    forall a b. (a -> b) -> a -> b
    $ Tele (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 =>
    Tele (Dom Type) -> m a -> m a
    addContext Tele (Dom Type)
    gamma (TCMT IO Doc -> TCMT IO Doc) -> TCMT IO Doc -> TCMT IO Doc
    forall a b. (a -> b) -> a -> b
    $
            TCMT IO Doc
    "body :" 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
    rhs

          String -> Nat -> TCMT IO Doc -> m ()
    forall (m :: * -> *).
    MonadDebug m =>
    String -> Nat -> TCMT IO Doc -> m ()
    reportSDoc String
    "tc.data.transp.con" Nat
    30 (TCMT IO Doc -> m ()) -> TCMT IO Doc -> m ()
    forall a b. (a -> b) -> a -> b
    $
            Tele (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 =>
    Tele (Dom Type) -> m a -> m a
    addContext Tele (Dom Type)
    gamma (TCMT IO Doc -> TCMT IO Doc) -> TCMT IO Doc -> TCMT IO Doc
    forall a b. (a -> b) -> a -> b
    $ TCMT IO Doc
    "c:" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> Clause -> TCMT IO Doc
    forall (m :: * -> *) a. (Applicative m, Pretty a) => a -> m Doc
    pretty Clause
    c
          Clause -> m Clause
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Clause
    c

    defineKanOperationForFields
      :: Command
      -> (Maybe Term)            -- ^ PathCons, Δ.Φ ⊢ u : R δ
      -> (Term -> QName -> Term) -- ^ how to apply a "projection" to a term
      -> QName       -- ^ some name, e.g. record name
      -> Telescope   -- ^ param types Δ
      -> Telescope   -- ^ fields' types Δ ⊢ Φ
      -> [Arg QName] -- ^ fields' names
      -> Type        -- ^ record type Δ ⊢ T
      -> TCM (Maybe ((QName, Telescope, Type, [Dom Type], [Term]), Substitution))
    defineKanOperationForFields :: Command
    -> Maybe Term
    -> (Term -> QName -> Term)
    -> QName
    -> Tele (Dom Type)
    -> Tele (Dom Type)
    -> [Arg QName]
    -> Type
    -> TCM
         (Maybe
            ((QName, Tele (Dom Type), Type, [Dom Type], [Term]), Substitution))
    defineKanOperationForFields Command
    cmd Maybe Term
    pathCons Term -> QName -> Term
    project QName
    name Tele (Dom Type)
    params Tele (Dom Type)
    fsT [Arg QName]
    fns Type
    rect =
       case Command
    cmd of
           Command
    DoTransp -> MaybeT
      (TCMT IO)
      ((QName, Tele (Dom Type), Type, [Dom Type], [Term]), Substitution)
    -> TCM
         (Maybe
            ((QName, Tele (Dom Type), Type, [Dom Type], [Term]), Substitution))
    forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
    runMaybeT (MaybeT
       (TCMT IO)
       ((QName, Tele (Dom Type), Type, [Dom Type], [Term]), Substitution)
     -> TCM
          (Maybe
             ((QName, Tele (Dom Type), Type, [Dom Type], [Term]),
              Substitution)))
    -> MaybeT
         (TCMT IO)
         ((QName, Tele (Dom Type), Type, [Dom Type], [Term]), Substitution)
    -> TCM
         (Maybe
            ((QName, Tele (Dom Type), Type, [Dom Type], [Term]), Substitution))
    forall a b. (a -> b) -> a -> b
    $ do
             fsT' <- (Dom Type -> MaybeT (TCMT IO) (Dom CType))
    -> Tele (Dom Type) -> MaybeT (TCMT IO) (Tele (Dom CType))
    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) -> Tele a -> f (Tele b)
    traverse ((Type -> MaybeT (TCMT IO) CType)
    -> Dom Type -> MaybeT (TCMT IO) (Dom CType)
    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) -> Dom' Term a -> f (Dom' Term b)
    traverse (TCMT IO (Maybe CType) -> MaybeT (TCMT IO) CType
    forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
    MaybeT (TCMT IO (Maybe CType) -> MaybeT (TCMT IO) CType)
    -> (Type -> TCMT IO (Maybe CType))
    -> Type
    -> MaybeT (TCMT IO) CType
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Type -> TCMT IO (Maybe CType)
    forall (m :: * -> *). MonadReduce m => Type -> m (Maybe CType)
    toCType)) Tele (Dom Type)
    fsT
             lift $ defineTranspForFields pathCons project name params fsT' fns rect
           Command
    DoHComp -> MaybeT
      (TCMT IO)
      ((QName, Tele (Dom Type), Type, [Dom Type], [Term]), Substitution)
    -> TCM
         (Maybe
            ((QName, Tele (Dom Type), Type, [Dom Type], [Term]), Substitution))
    forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
    runMaybeT (MaybeT
       (TCMT IO)
       ((QName, Tele (Dom Type), Type, [Dom Type], [Term]), Substitution)
     -> TCM
          (Maybe
             ((QName, Tele (Dom Type), Type, [Dom Type], [Term]),
              Substitution)))
    -> MaybeT
         (TCMT IO)
         ((QName, Tele (Dom Type), Type, [Dom Type], [Term]), Substitution)
    -> TCM
         (Maybe
            ((QName, Tele (Dom Type), Type, [Dom Type], [Term]), Substitution))
    forall a b. (a -> b) -> a -> b
    $ do
             fsT' <- (Dom Type -> MaybeT (TCMT IO) (Dom LType))
    -> Tele (Dom Type) -> MaybeT (TCMT IO) (Tele (Dom LType))
    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) -> Tele a -> f (Tele b)
    traverse ((Type -> MaybeT (TCMT IO) LType)
    -> Dom Type -> MaybeT (TCMT IO) (Dom LType)
    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) -> Dom' Term a -> f (Dom' Term b)
    traverse (TCMT IO (Maybe LType) -> MaybeT (TCMT IO) LType
    forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
    MaybeT (TCMT IO (Maybe LType) -> MaybeT (TCMT IO) LType)
    -> (Type -> TCMT IO (Maybe LType))
    -> Type
    -> MaybeT (TCMT IO) LType
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Type -> TCMT IO (Maybe LType)
    forall (m :: * -> *). MonadReduce m => Type -> m (Maybe LType)
    toLType)) Tele (Dom Type)
    fsT
             rect' <- MaybeT $ toLType rect
             lift $ defineHCompForFields project name params fsT' fns rect'

    -- invariant: resulting tel Γ is such that Γ = ... , (φ : I), (a0 : ...)
    --            where a0 has type matching the arguments of primTrans.
    defineTranspForFields
      :: (Maybe Term)            -- ^ PathCons, Δ.Φ ⊢ u : R δ
      -> (Term -> QName -> Term) -- ^ how to apply a "projection" to a term
      -> QName       -- ^ some name, e.g. record name
      -> Telescope   -- ^ param types Δ
      -> Tele (Dom CType)   -- ^ fields' types Δ ⊢ Φ
      -> [Arg QName] -- ^ fields' names
      -> Type        -- ^ record type Δ ⊢ T
      -> TCM ((QName, Telescope, Type, [Dom Type], [Term]), Substitution)
         -- ^ @((name, tel, rtype, clause_types, bodies), sigma)@
         --   name: name of transport function for this constructor/record. clauses still missing.
         --   tel: Ξ telescope for the RHS, Ξ ⊃ (Δ^I, φ : I), also Ξ ⊢ us0 : Φ[δ 0]
         --   rtype: Ξ ⊢ T' := T[δ 1]
         --   clause_types: Ξ ⊢ Φ' := Φ[δ 1]
         --   bodies: Ξ ⊢ us1 : Φ'
         --   sigma:  Ξ, i : I ⊢ σ : Δ.Φ -- line [δ 0,us0] ≡ [δ 0,us1]
    defineTranspForFields :: Maybe Term
    -> (Term -> QName -> Term)
    -> QName
    -> Tele (Dom Type)
    -> Tele (Dom CType)
    -> [Arg QName]
    -> Type
    -> TCMT
         IO
         ((QName, Tele (Dom Type), Type, [Dom Type], [Term]), Substitution)
    defineTranspForFields Maybe Term
    pathCons Term -> QName -> Term
    applyProj QName
    name Tele (Dom Type)
    params Tele (Dom CType)
    fsT [Arg QName]
    fns Type
    rect = do
      interval <- TCMT IO Type
    forall (m :: * -> *).
    (HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
    m Type
    primIntervalType
      let deltaI = Type -> Tele (Dom Type) -> Tele (Dom Type)
    expTelescope Type
    interval Tele (Dom Type)
    params
      iz <- primIZero
      io <- primIOne
      imin <- getPrimitiveTerm builtinIMin
      imax <- getPrimitiveTerm builtinIMax
      ineg <- getPrimitiveTerm builtinINeg
      transp <- getPrimitiveTerm builtinTrans
      -- por <- getPrimitiveTerm "primPOr"
      -- one <- primItIsOne
      reportSDoc "trans.rec" 20 $ pretty params
      reportSDoc "trans.rec" 20 $ pretty deltaI
      reportSDoc "trans.rec" 10 $ pretty fsT

      let thePrefix = String
    "transp-"
      theName <- freshAbstractQName'_ $ thePrefix ++ P.prettyShow (A.qnameName name)

      reportSLn "trans.rec" 5 $ ("Generated name: " ++ show theName ++ " " ++ showQNameId theName)

      theType <- (abstract deltaI <$>) $ runNamesT [] $ do
                  rect' <- open (runNames [] $ bind "i" $ \ forall b. (Subst b, DeBruijn b) => NamesT Identity b
    x -> let NamesT Identity Term
    _ = NamesT Identity Term
    forall b. (Subst b, DeBruijn b) => NamesT Identity b
    x NamesT Identity Term
    -> NamesT Identity Term -> NamesT Identity Term
    forall a. a -> a -> a
    `asTypeOf` Term -> NamesT Identity Term
    forall a. a -> NamesT Identity a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Term
    forall a. HasCallStack => a
    undefined :: Term) in
                                                                 Type -> NamesT Identity Type
    forall a. a -> NamesT Identity a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Type
    rect')
                  nPi' "phi" primIntervalType $ \ NamesT (TCMT IO) Term
    phi ->
                   (Abs Type -> Term -> Type
    Abs Type -> SubstArg Type -> Type
    forall a. Subst a => Abs a -> SubstArg a -> a
    absApp (Abs Type -> Term -> Type)
    -> NamesT (TCMT IO) (Abs Type) -> NamesT (TCMT IO) (Term -> Type)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> NamesT (TCMT IO) (Abs Type)
    rect' NamesT (TCMT IO) (Term -> Type)
    -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
    forall a b.
    NamesT (TCMT IO) (a -> b)
    -> NamesT (TCMT IO) a -> NamesT (TCMT IO) b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Term -> NamesT (TCMT IO) Term
    forall a. a -> NamesT (TCMT IO) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Term
    iz) NamesT (TCMT IO) Type
    -> NamesT (TCMT IO) Type -> NamesT (TCMT IO) Type
    forall (m :: * -> *). Applicative m => m Type -> m Type -> m Type
    --> (Abs Type -> Term -> Type
    Abs Type -> SubstArg Type -> Type
    forall a. Subst a => Abs a -> SubstArg a -> a
    absApp (Abs Type -> Term -> Type)
    -> NamesT (TCMT IO) (Abs Type) -> NamesT (TCMT IO) (Term -> Type)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> NamesT (TCMT IO) (Abs Type)
    rect' NamesT (TCMT IO) (Term -> Type)
    -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
    forall a b.
    NamesT (TCMT IO) (a -> b)
    -> NamesT (TCMT IO) a -> NamesT (TCMT IO) b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Term -> NamesT (TCMT IO) Term
    forall a. a -> NamesT (TCMT IO) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Term
    io)

      reportSDoc "trans.rec" 20 $ prettyTCM theType
      reportSDoc "trans.rec" 60 $ text $ "sort = " ++ show (getSort rect')

      lang <- getLanguage
      fun  <- emptyFunctionData
      noMutualBlock $ addConstant theName $
        (defaultDefn defaultArgInfo theName theType lang
           (FunctionDefn fun{ _funTerminates = Just True
                            , _funIsKanOp    = Just name
                            }))
          { defNoCompilation = True }
      -- ⊢ Γ = gamma = (δ : Δ^I) (φ : I) (u0 : R (δ i0))
      -- Γ ⊢     rtype = R (δ i1)
      TelV gamma rtype <- telView theType

      let
          -- (γ : Γ) ⊢ transpR γ : rtype
          theTerm = QName -> [Elim' Term] -> Term
    Def QName
    theName [] Term -> [Arg Term] -> Term
    forall t. Apply t => t -> [Arg Term] -> t
    `apply` Tele (Dom Type) -> [Arg Term]
    forall a t. DeBruijn a => Tele (Dom t) -> [Arg a]
    teleArgs Tele (Dom Type)
    gamma

          -- (γ : Γ) ⊢ (flatten Φ[δ i1])[n ↦ f_n (transpR γ)]
          clause_types = [Term] -> Substitution
    forall a. DeBruijn a => [a] -> Substitution' a
    parallelS [Term
    theTerm Term -> QName -> Term
    `applyProj` (Arg QName -> QName
    forall e. Arg e -> e
    unArg Arg QName
    fn)
                                   | Arg QName
    fn <- [Arg QName] -> [Arg QName]
    forall a. [a] -> [a]
    reverse [Arg QName]
    fns] Substitution' (SubstArg [Dom CType]) -> [Dom CType] -> [Dom CType]
    forall a. Subst a => Substitution' (SubstArg a) -> a -> a
    `applySubst`
                           Tele (Dom CType) -> [Dom CType]
    forall a. TermSubst a => Tele (Dom a) -> [Dom a]
    flattenTel (Nat -> Term -> Substitution
    forall a. DeBruijn a => Nat -> a -> Substitution' a
    singletonS Nat
    0 Term
    io Substitution' (SubstArg (Tele (Dom CType)))
    -> Tele (Dom CType) -> Tele (Dom CType)
    forall a. Subst a => Substitution' (SubstArg a) -> a -> a
    `applySubst` Tele (Dom CType)
    fsT') -- Γ, Φ[δ i1] ⊢ flatten Φ[δ i1]

          -- Γ, i : I ⊢ [δ i] : Δ
          delta_i = (Nat -> Substitution -> Substitution
    forall a. Nat -> Substitution' a -> Substitution' a
    liftS Nat
    1 (Nat -> Substitution
    forall a. Nat -> Substitution' a
    raiseS (Tele (Dom Type) -> Nat
    forall a. Sized a => a -> Nat
    size Tele (Dom Type)
    gamma Nat -> Nat -> Nat
    forall a. Num a => a -> a -> a
    - Tele (Dom Type) -> Nat
    forall a. Sized a => a -> Nat
    size Tele (Dom Type)
    deltaI)) Substitution -> Substitution -> Substitution
    forall a.
    EndoSubst a =>
    Substitution' a -> Substitution' a -> Substitution' a
    `composeS` Tele (Dom Type) -> Substitution
    forall {a}. Sized a => a -> Substitution
    sub Tele (Dom Type)
    params) -- Defined but not used

          -- Γ, i : I ⊢ Φ[δ i]
          fsT' = (Nat -> Substitution -> Substitution
    forall a. Nat -> Substitution' a -> Substitution' a
    liftS Nat
    1 (Nat -> Substitution
    forall a. Nat -> Substitution' a
    raiseS (Tele (Dom Type) -> Nat
    forall a. Sized a => a -> Nat
    size Tele (Dom Type)
    gamma Nat -> Nat -> Nat
    forall a. Num a => a -> a -> a
    - Tele (Dom Type) -> Nat
    forall a. Sized a => a -> Nat
    size Tele (Dom Type)
    deltaI)) Substitution -> Substitution -> Substitution
    forall a.
    EndoSubst a =>
    Substitution' a -> Substitution' a -> Substitution' a
    `composeS` Tele (Dom Type) -> Substitution
    forall {a}. Sized a => a -> Substitution
    sub Tele (Dom Type)
    params)  Substitution' (SubstArg (Tele (Dom CType)))
    -> Tele (Dom CType) -> Tele (Dom CType)
    forall a. Subst a => Substitution' (SubstArg a) -> a -> a
    `applySubst`
                   Tele (Dom CType)
    fsT -- Δ ⊢ Φ
          lam_i = ArgInfo -> Abs Term -> Term
    Lam ArgInfo
    defaultArgInfo (Abs Term -> Term) -> (Term -> Abs Term) -> Term -> Term
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> Term -> Abs Term
    forall a. String -> a -> Abs a
    Abs String
    "i"

          -- (δ , φ , u0) : Γ ⊢ φ : I
          -- the_phi = var 1
          -- -- (δ , φ , u0) : Γ ⊢ u0 : R (δ i0)
          -- the_u0  = var 0

          -- Γ' = (δ : Δ^I, φ : I)
          gamma' = [Dom' Term (String, Type)] -> Tele (Dom Type)
    telFromList ([Dom' Term (String, Type)] -> Tele (Dom Type))
    -> [Dom' Term (String, Type)] -> Tele (Dom Type)
    forall a b. (a -> b) -> a -> b
    $ Nat -> [Dom' Term (String, Type)] -> [Dom' Term (String, Type)]
    forall a. Nat -> [a] -> [a]
    take (Tele (Dom Type) -> Nat
    forall a. Sized a => a -> Nat
    size Tele (Dom Type)
    gamma Nat -> Nat -> Nat
    forall a. Num a => a -> a -> a
    - Nat
    1) ([Dom' Term (String, Type)] -> [Dom' Term (String, Type)])
    -> [Dom' Term (String, Type)] -> [Dom' Term (String, Type)]
    forall a b. (a -> b) -> a -> b
    $ Tele (Dom Type) -> [Dom' Term (String, Type)]
    forall t. Tele (Dom t) -> [Dom (String, t)]
    telToList Tele (Dom Type)
    gamma

          -- δ : Δ^I, φ : F ⊢ [δ 0] : Δ
          d0 :: Substitution
          d0 = Nat -> Substitution -> Substitution
    forall a. Nat -> Substitution' a -> Substitution' a
    wkS Nat
    1 -- Δ^I, φ : F ⊢ Δ
                           (Term -> Substitution -> Substitution
    forall a. DeBruijn a => a -> Substitution' a -> Substitution' a
    consS Term
    iz Substitution
    forall a. Substitution' a
    IdS Substitution -> Substitution -> Substitution
    forall a.
    EndoSubst a =>
    Substitution' a -> Substitution' a -> Substitution' a
    `composeS` Tele (Dom Type) -> Substitution
    forall {a}. Sized a => a -> Substitution
    sub Tele (Dom Type)
    params) -- Δ^I ⊢ Δ
                                     -- Δ^I , i:I ⊢ sub params : Δ

          -- Ξ , Ξ ⊢ θ : Γ, Ξ ⊢ φ, Ξ ⊢ u : R (δ i0), Ξ ⊢ us : Φ[δ i0]
          (tel,theta,the_phi,the_u0, the_fields) =
            case pathCons of
              -- (δ : Δ).Φ ⊢ u : R δ
              Just Term
    u -> (Tele (Dom Type) -> Tele (Dom Type) -> Tele (Dom Type)
    forall t. Abstract t => Tele (Dom Type) -> t -> t
    abstract Tele (Dom Type)
    gamma' (Substitution
    Substitution' (SubstArg (Tele (Dom Type)))
    d0 Substitution' (SubstArg (Tele (Dom Type)))
    -> Tele (Dom Type) -> Tele (Dom Type)
    forall a. Subst a => Substitution' (SubstArg a) -> a -> a
    `applySubst` (Dom CType -> Dom Type) -> Tele (Dom CType) -> Tele (Dom Type)
    forall a b. (a -> b) -> Tele a -> Tele b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((CType -> Type) -> Dom CType -> Dom Type
    forall a b. (a -> b) -> Dom' Term a -> Dom' Term b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap CType -> Type
    fromCType) Tele (Dom CType)
    fsT) -- Ξ = δ : Δ^I, φ : F, _ : Φ[δ i0]
                        , (Nat -> Substitution -> Substitution
    forall a. Nat -> Substitution' a -> Substitution' a
    liftS (Tele (Dom CType) -> Nat
    forall a. Sized a => a -> Nat
    size Tele (Dom CType)
    fsT) Substitution
    d0 Substitution' (SubstArg Term) -> Term -> Term
    forall a. Subst a => Substitution' (SubstArg a) -> a -> a
    `applySubst` Term
    u) Term -> Substitution -> Substitution
    forall a. DeBruijn a => a -> Substitution' a -> Substitution' a
    `consS` Nat -> Substitution
    forall a. Nat -> Substitution' a
    raiseS (Tele (Dom CType) -> Nat
    forall a. Sized a => a -> Nat
    size Tele (Dom CType)
    fsT)
                        , Nat -> Term -> Term
    forall a. Subst a => Nat -> a -> a
    raise (Tele (Dom CType) -> Nat
    forall a. Sized a => a -> Nat
    size Tele (Dom CType)
    fsT) (Nat -> Term
    var Nat
    0)
                        , (Nat -> Substitution -> Substitution
    forall a. Nat -> Substitution' a -> Substitution' a
    liftS (Tele (Dom CType) -> Nat
    forall a. Sized a => a -> Nat
    size Tele (Dom CType)
    fsT) Substitution
    d0 Substitution' (SubstArg Term) -> Term -> Term
    forall a. Subst a => Substitution' (SubstArg a) -> a -> a
    `applySubst` Term
    u)
                        , Nat -> [Term] -> [Term]
    forall a. Nat -> [a] -> [a]
    drop (Tele (Dom Type) -> Nat
    forall a. Sized a => a -> Nat
    size Tele (Dom Type)
    gamma') ([Term] -> [Term]) -> [Term] -> [Term]
    forall a b. (a -> b) -> a -> b
    $ (Arg Term -> Term) -> [Arg Term] -> [Term]
    forall a b. (a -> b) -> [a] -> [b]
    map Arg Term -> Term
    forall e. Arg e -> e
    unArg ([Arg Term] -> [Term]) -> [Arg Term] -> [Term]
    forall a b. (a -> b) -> a -> b
    $ Tele (Dom Type) -> [Arg Term]
    forall a t. DeBruijn a => Tele (Dom t) -> [Arg a]
    teleArgs Tele (Dom Type)
    tel)
              Maybe Term
    Nothing -> (Tele (Dom Type)
    gamma, Substitution
    forall a. Substitution' a
    IdS, Nat -> Term
    var Nat
    1, Nat -> Term
    var Nat
    0, (Arg QName -> Term) -> [Arg QName] -> [Term]
    forall a b. (a -> b) -> [a] -> [b]
    map (\ Arg QName
    fname -> Nat -> Term
    var Nat
    0 Term -> QName -> Term
    `applyProj` Arg QName -> QName
    forall e. Arg e -> e
    unArg Arg QName
    fname) [Arg QName]
    fns )

          fsT_tel = (Nat -> Substitution -> Substitution
    forall a. Nat -> Substitution' a -> Substitution' a
    liftS Nat
    1 (Nat -> Substitution
    forall a. Nat -> Substitution' a
    raiseS (Tele (Dom Type) -> Nat
    forall a. Sized a => a -> Nat
    size Tele (Dom Type)
    tel Nat -> Nat -> Nat
    forall a. Num a => a -> a -> a
    - Tele (Dom Type) -> Nat
    forall a. Sized a => a -> Nat
    size Tele (Dom Type)
    deltaI)) Substitution -> Substitution -> Substitution
    forall a.
    EndoSubst a =>
    Substitution' a -> Substitution' a -> Substitution' a
    `composeS` Tele (Dom Type) -> Substitution
    forall {a}. Sized a => a -> Substitution
    sub Tele (Dom Type)
    params) Substitution' (SubstArg (Tele (Dom CType)))
    -> Tele (Dom CType) -> Tele (Dom CType)
    forall a. Subst a => Substitution' (SubstArg a) -> a -> a
    `applySubst` Tele (Dom CType)
    fsT

          iMin Term
    x Term
    y = Term
    imin Term -> [Arg Term] -> Term
    forall t. Apply t => t -> [Arg Term] -> t
    `apply` [Term -> Arg Term
    forall e. e -> Arg e
    argN Term
    x, Term -> Arg Term
    forall e. e -> Arg e
    argN Term
    y]
          iMax Term
    x Term
    y = Term
    imax Term -> [Arg Term] -> Term
    forall t. Apply t => t -> [Arg Term] -> t
    `apply` [Term -> Arg Term
    forall e. e -> Arg e
    argN Term
    x, Term -> Arg Term
    forall e. e -> Arg e
    argN Term
    y]
          iNeg Term
    x = Term
    ineg Term -> [Arg Term] -> Term
    forall t. Apply t => t -> [Arg Term] -> t
    `apply` [Term -> Arg Term
    forall e. e -> Arg e
    argN Term
    x]

          -- .. ⊢ field : filled_ty' i0
          mkBody (Term
    field, Dom CType
    filled_ty') = do
            let
              filled_ty :: Term
    filled_ty = Term -> Term
    lam_i (Term -> Term) -> Term -> Term
    forall a b. (a -> b) -> a -> b
    $ (Type -> Term
    forall t a. Type'' t a -> a
    unEl (Type -> Term) -> (Dom CType -> Type) -> Dom CType -> Term
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . CType -> Type
    fromCType (CType -> Type) -> (Dom CType -> CType) -> Dom CType -> Type
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Dom CType -> CType
    forall t e. Dom' t e -> e
    unDom) Dom CType
    filled_ty'
              -- Γ ⊢ l : I -> Level of filled_ty
            -- sort <- reduce $ getSort $ unDom filled_ty'
            case Dom CType -> CType
    forall t e. Dom' t e -> e
    unDom Dom CType
    filled_ty' of
              LType (LEl Level
    l Term
    _) -> do
                let lvl :: Term
    lvl = Term -> Term
    lam_i (Term -> Term) -> Term -> Term
    forall a b. (a -> b) -> a -> b
    $ Level -> Term
    Level Level
    l
                Term -> TCMT IO Term
    forall a. a -> TCMT IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Term -> TCMT IO Term) -> Term -> TCMT IO Term
    forall a b. (a -> b) -> a -> b
    $ Names -> NamesT Identity Term -> Term
    forall a. Names -> NamesT Identity a -> a
    runNames [] (NamesT Identity Term -> Term) -> NamesT Identity Term -> Term
    forall a b. (a -> b) -> a -> b
    $ do
                 lvl <- Term -> NamesT Identity (NamesT Identity Term)
    forall (m :: * -> *) a.
    (Monad m, Subst a) =>
    a -> NamesT m (NamesT m a)
    open Term
    lvl
                 phi <- open the_phi
                 field <- open field
                 pure transp <#> lvl <@> pure filled_ty
                                     <@> phi
                                     <@> field
              -- interval arg
              ClosedType{}  ->
                Term -> TCMT IO Term
    forall a. a -> TCMT IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Term -> TCMT IO Term) -> Term -> TCMT IO Term
    forall a b. (a -> b) -> a -> b
    $ Names -> NamesT Identity Term -> Term
    forall a. Names -> NamesT Identity a -> a
    runNames [] (NamesT Identity Term -> Term) -> NamesT Identity Term -> Term
    forall a b. (a -> b) -> a -> b
    $ do
                  field <- Term -> NamesT Identity (NamesT Identity Term)
    forall (m :: * -> *) a.
    (Monad m, Subst a) =>
    a -> NamesT m (NamesT m a)
    open Term
    field
                  field
      let
            -- ' Ξ , i : I ⊢ τ = [(\ j → δ (i ∧ j)), φ ∨ ~ i, u] : Ξ
            tau = [Term] -> Substitution
    forall a. DeBruijn a => [a] -> Substitution' a
    parallelS ([Term] -> Substitution) -> [Term] -> Substitution
    forall a b. (a -> b) -> a -> b
    $ [Term]
    us [Term] -> [Term] -> [Term]
    forall a. [a] -> [a] -> [a]
    ++ (Term
    phi Term -> Term -> Term
    `iMax` Term -> Term
    iNeg (Nat -> Term
    var Nat
    0))
                            Term -> [Term] -> [Term]
    forall a. a -> [a] -> [a]
    : (Term -> Term) -> [Term] -> [Term]
    forall a b. (a -> b) -> [a] -> [b]
    map (\ Term
    d -> ArgInfo -> Abs Term -> Term
    Lam ArgInfo
    defaultArgInfo (Abs Term -> Term) -> Abs Term -> Term
    forall a b. (a -> b) -> a -> b
    $ String -> Term -> Abs Term
    forall a. String -> a -> Abs a
    Abs String
    "i" (Term -> Abs Term) -> Term -> Abs Term
    forall a b. (a -> b) -> a -> b
    $ Nat -> Term -> Term
    forall a. Subst a => Nat -> a -> a
    raise Nat
    1 Term
    d Term -> [Arg Term] -> Term
    forall t. Apply t => t -> [Arg Term] -> t
    `apply` [Term -> Arg Term
    forall e. e -> Arg e
    argN (Term -> Arg Term) -> Term -> Arg Term
    forall a b. (a -> b) -> a -> b
    $ (Term -> Term -> Term
    iMin (Nat -> Term
    var Nat
    0) (Nat -> Term
    var Nat
    1))]) [Term]
    ds
             where
              -- Ξ, i : I
              ([Term]
    us, Term
    phi:[Term]
    ds) = Nat -> [Term] -> ([Term], [Term])
    forall a. Nat -> [a] -> ([a], [a])
    splitAt (Tele (Dom Type) -> Nat
    forall a. Sized a => a -> Nat
    size Tele (Dom Type)
    tel Nat -> Nat -> Nat
    forall a. Num a => a -> a -> a
    - Tele (Dom Type) -> Nat
    forall a. Sized a => a -> Nat
    size Tele (Dom Type)
    gamma') ([Term] -> ([Term], [Term])) -> [Term] -> ([Term], [Term])
    forall a b. (a -> b) -> a -> b
    $ [Term] -> [Term]
    forall a. [a] -> [a]
    reverse (Nat -> [Term] -> [Term]
    forall a. Subst a => Nat -> a -> a
    raise Nat
    1 ((Arg Term -> Term) -> [Arg Term] -> [Term]
    forall a b. (a -> b) -> [a] -> [b]
    map Arg Term -> Term
    forall e. Arg e -> e
    unArg (Tele (Dom Type) -> [Arg Term]
    forall a t. DeBruijn a => Tele (Dom t) -> [Arg a]
    teleArgs Tele (Dom Type)
    tel)))

      let
        go [Term]
    acc [] = [Term] -> TCMT IO [Term]
    forall a. a -> TCMT IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return []
        go [Term]
    acc ((Term
    fname,Dom CType
    field_ty) : [(Term, Dom CType)]
    ps) = do
          -- Ξ, i : I, Φ[δ i]|_f ⊢ Φ_f = field_ty
          -- Ξ ⊢ b : field_ty [i := i1][acc]
          -- Ξ ⊢ parallesS acc : Φ[δ i1]|_f
          -- Ξ , i : I ⊢ τ = [(\ j → δ (i ∨ j), φ ∨ ~ i, us] : Ξ
          -- Ξ , i : I ⊢ parallesS (acc[τ]) : Φ[δ i1]|_f
          -- Ξ, i : I ⊢ field_ty [parallesS (acc[τ])]
          let
            filled_ty :: Dom CType
    filled_ty = [Term] -> Substitution
    forall a. DeBruijn a => [a] -> Substitution' a
    parallelS (Substitution
    Substitution' (SubstArg [Term])
    tau Substitution' (SubstArg [Term]) -> [Term] -> [Term]
    forall a. Subst a => Substitution' (SubstArg a) -> a -> a
    `applySubst` [Term]
    acc) Substitution' (SubstArg (Dom CType)) -> Dom CType -> Dom CType
    forall a. Subst a => Substitution' (SubstArg a) -> a -> a
    `applySubst` Dom CType
    field_ty
          b <- (Term, Dom CType) -> TCMT IO Term
    mkBody (Term
    fname,Dom CType
    filled_ty)
          bs <- go (b : acc) ps
          return $ b : bs

      bodys <- go [] (zip the_fields (map (fmap snd) $ telToList fsT_tel)) -- ∀ f.  Ξ, i : I, Φ[δ i]|_f ⊢ Φ[δ i]_f
      let
        -- Ξ, i : I ⊢ ... : Δ.Φ
        theSubst = [Term] -> [Term]
    forall a. [a] -> [a]
    reverse (Substitution
    Substitution' (SubstArg [Term])
    tau Substitution' (SubstArg [Term]) -> [Term] -> [Term]
    forall a. Subst a => Substitution' (SubstArg a) -> a -> a
    `applySubst` [Term]
    bodys) [Term] -> Substitution -> Substitution
    forall a. DeBruijn a => [a] -> Substitution' a -> Substitution' a
    ++# (Nat -> Substitution -> Substitution
    forall a. Nat -> Substitution' a -> Substitution' a
    liftS Nat
    1 (Nat -> Substitution
    forall a. Nat -> Substitution' a
    raiseS (Tele (Dom Type) -> Nat
    forall a. Sized a => a -> Nat
    size Tele (Dom Type)
    tel Nat -> Nat -> Nat
    forall a. Num a => a -> a -> a
    - Tele (Dom Type) -> Nat
    forall a. Sized a => a -> Nat
    size Tele (Dom Type)
    deltaI)) Substitution -> Substitution -> Substitution
    forall a.
    EndoSubst a =>
    Substitution' a -> Substitution' a -> Substitution' a
    `composeS` Tele (Dom Type) -> Substitution
    forall {a}. Sized a => a -> Substitution
    sub Tele (Dom Type)
    params)
      return $ ((theName, tel, theta `applySubst` rtype, map (fmap fromCType) clause_types, bodys), theSubst)
      where
        -- record type in 'exponentiated' context
        -- (params : Δ^I), i : I |- T[params i]
        rect' :: Type
    rect' = Tele (Dom Type) -> Substitution
    forall {a}. Sized a => a -> Substitution
    sub Tele (Dom Type)
    params Substitution' (SubstArg Type) -> Type -> Type
    forall a. Subst a => Substitution' (SubstArg a) -> a -> a
    `applySubst` Type
    rect
        -- Δ^I, i : I |- sub Δ : Δ
        sub :: a -> Substitution
    sub a
    tel = Nat -> Substitution
    expS (Nat -> Substitution) -> Nat -> Substitution
    forall a b. (a -> b) -> a -> b
    $ a -> Nat
    forall a. Sized a => a -> Nat
    size a
    tel

    -- invariant: resulting tel Γ is such that Γ = (δ : Δ), (φ : I), (u : ...), (a0 : R δ))
    --            where u and a0 have types matching the arguments of primHComp.
    defineHCompForFields
      :: (Term -> QName -> Term) -- ^ how to apply a "projection" to a term
      -> QName       -- ^ some name, e.g. record name
      -> Telescope   -- ^ param types Δ
      -> Tele (Dom LType)   -- ^ fields' types Δ ⊢ Φ
      -> [Arg QName] -- ^ fields' names
      -> LType        -- ^ record type (δ : Δ) ⊢ R[δ]
      -> TCM ((QName, Telescope, Type, [Dom Type], [Term]),Substitution)
    defineHCompForFields :: (Term -> QName -> Term)
    -> QName
    -> Tele (Dom Type)
    -> Tele (Dom LType)
    -> [Arg QName]
    -> LType
    -> TCMT
         IO
         ((QName, Tele (Dom Type), Type, [Dom Type], [Term]), Substitution)
    defineHCompForFields Term -> QName -> Term
    applyProj QName
    name Tele (Dom Type)
    params Tele (Dom LType)
    fsT [Arg QName]
    fns LType
    rect = do
      interval <- TCMT IO Type
    forall (m :: * -> *).
    (HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
    m Type
    primIntervalType
      let delta = Tele (Dom Type)
    params
      iz <- primIZero
      io <- primIOne
      imin <- getPrimitiveTerm builtinIMin
      imax <- getPrimitiveTerm builtinIMax
      tIMax <- getPrimitiveTerm builtinIMax
      ineg <- getPrimitiveTerm builtinINeg
      hcomp <- getPrimitiveTerm builtinHComp
      transp <- getPrimitiveTerm builtinTrans
      por <- getPrimitiveTerm builtinPOr
      one <- primItIsOne
      reportSDoc "comp.rec" 20 $ text $ show params
      reportSDoc "comp.rec" 20 $ text $ show delta
      reportSDoc "comp.rec" 10 $ text $ show fsT

      let thePrefix = String
    "hcomp-"
      theName <- freshAbstractQName'_ $ thePrefix ++ P.prettyShow (A.qnameName name)

      reportSLn "hcomp.rec" 5 $ ("Generated name: " ++ show theName ++ " " ++ showQNameId theName)

      theType <- (abstract delta <$>) $ runNamesT [] $ do
                  rect <- open $ fromLType rect
                  nPi' "phi" primIntervalType $ \ NamesT (TCMT IO) Term
    phi ->
                   String
    -> NamesT (TCMT IO) Type
    -> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
    -> NamesT (TCMT IO) Type
    forall (m :: * -> *).
    (MonadAddContext m, MonadDebug m) =>
    String
    -> NamesT m Type
    -> (NamesT m Term -> NamesT m Type)
    -> NamesT m Type
    nPi' String
    "i" NamesT (TCMT IO) Type
    forall (m :: * -> *).
    (HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
    m Type
    primIntervalType (\ NamesT (TCMT IO) Term
    i ->
                    String
    -> NamesT (TCMT IO) Term
    -> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
    -> NamesT (TCMT IO) Type
    forall (m :: * -> *).
    (MonadAddContext m, HasBuiltins m, MonadDebug m) =>
    String
    -> NamesT m Term
    -> (NamesT m Term -> NamesT m Type)
    -> NamesT m Type
    pPi' String
    "o" NamesT (TCMT IO) Term
    phi ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
     -> NamesT (TCMT IO) Type)
    -> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
    -> NamesT (TCMT IO) Type
    forall a b. (a -> b) -> a -> b
    $ \ NamesT (TCMT IO) Term
    _ -> NamesT (TCMT IO) Type
    rect) NamesT (TCMT IO) Type
    -> NamesT (TCMT IO) Type -> NamesT (TCMT IO) Type
    forall (m :: * -> *). Applicative m => m Type -> m Type -> m Type
    -->
                   NamesT (TCMT IO) Type
    rect NamesT (TCMT IO) Type
    -> NamesT (TCMT IO) Type -> NamesT (TCMT IO) Type
    forall (m :: * -> *). Applicative m => m Type -> m Type -> m Type
    --> NamesT (TCMT IO) Type
    rect

      reportSDoc "hcomp.rec" 20 $ prettyTCM theType
      reportSDoc "hcomp.rec" 60 $ text $ "sort = " ++ show (lTypeLevel rect)

      lang <- getLanguage
      fun  <- emptyFunctionData
      noMutualBlock $ addConstant theName $
        (defaultDefn defaultArgInfo theName theType lang
           (FunctionDefn fun{ _funTerminates = Just True
                            , _funIsKanOp    = Just name
                            }))
          { defNoCompilation = True }
      --   ⊢ Γ = gamma = (δ : Δ) (φ : I) (_ : (i : I) -> Partial φ (R δ)) (_ : R δ)
      -- Γ ⊢     rtype = R δ
      TelV gamma rtype <- telView theType

      let -- Γ ⊢ R δ
          drect_gamma = Nat -> Substitution
    forall a. Nat -> Substitution' a
    raiseS (Tele (Dom Type) -> Nat
    forall a. Sized a => a -> Nat
    size Tele (Dom Type)
    gamma Nat -> Nat -> Nat
    forall a. Num a => a -> a -> a
    - Tele (Dom Type) -> Nat
    forall a. Sized a => a -> Nat
    size Tele (Dom Type)
    delta) Substitution' (SubstArg LType) -> LType -> LType
    forall a. Subst a => Substitution' (SubstArg a) -> a -> a
    `applySubst` LType
    rect

      reportSDoc "hcomp.rec" 60 $ text $ "sort = " ++ show (lTypeLevel drect_gamma)

      let

          -- (γ : Γ) ⊢ hcompR γ : rtype
          compTerm = QName -> [Elim' Term] -> Term
    Def QName
    theName [] Term -> [Arg Term] -> Term
    forall t. Apply t => t -> [Arg Term] -> t
    `apply` Tele (Dom Type) -> [Arg Term]
    forall a t. DeBruijn a => Tele (Dom t) -> [Arg a]
    teleArgs Tele (Dom Type)
    gamma

          -- (δ, φ, u, u0) : Γ ⊢ φ : I
          the_phi = Nat -> Term
    var Nat
    2
          -- (δ, φ, u, u0) : Γ ⊢ u : (i : I) → [φ] → R (δ i)
          the_u   = Nat -> Term
    var Nat
    1
          -- (δ, φ, u, u0) : Γ ⊢ u0 : R (δ i0)
          the_u0  = Nat -> Term
    var Nat
    0

          -- ' (δ, φ, u, u0) : Γ ⊢ fillR Γ : (i : I) → rtype[ δ ↦ (\ j → δ (i ∧ j))]
          fillTerm = Names -> NamesT Identity Term -> Term
    forall a. Names -> NamesT Identity a -> a
    runNames [] (NamesT Identity Term -> Term) -> NamesT Identity Term -> Term
    forall a b. (a -> b) -> a -> b
    $ do
            rect   <- Term -> NamesT Identity (NamesT Identity Term)
    forall (m :: * -> *) a.
    (Monad m, Subst a) =>
    a -> NamesT m (NamesT m a)
    open (Term -> NamesT Identity (NamesT Identity Term))
    -> (LType -> Term)
    -> LType
    -> NamesT Identity (NamesT Identity Term)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Type -> Term
    forall t a. Type'' t a -> a
    unEl  (Type -> Term) -> (LType -> Type) -> LType -> Term
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . LType -> Type
    fromLType  (LType -> NamesT Identity (NamesT Identity Term))
    -> LType -> NamesT Identity (NamesT Identity Term)
    forall a b. (a -> b) -> a -> b
    $ LType
    drect_gamma
            lvl    <- open . Level . lTypeLevel $ drect_gamma
            params <- mapM open $ take (size delta) $ teleArgs gamma
            phi    <- open the_phi
            w      <- open the_u
            w0     <- open the_u0
            -- (δ : Δ, φ : I, w : .., w0 : R δ) ⊢
            -- ' fillR Γ = λ i → hcompR δ (φ ∨ ~ i) (\ j → [ φ ↦ w (i ∧ j) , ~ i ↦ w0 ]) w0
            --           = hfillR δ φ w w0
            lam "i" $ \ NamesT Identity Term
    i -> do
              args <- [NamesT Identity (Arg Term)] -> NamesT Identity [Arg Term]
    forall (t :: * -> *) (m :: * -> *) a.
    (Traversable t, Monad m) =>
    t (m a) -> m (t a)
    forall (m :: * -> *) a. Monad m => [m a] -> m [a]
    sequence [NamesT Identity (Arg Term)]
    params
              psi  <- pure imax <@> phi <@> (pure ineg <@> i)
              u <- lam "j" (\ NamesT Identity Term
    j -> Term -> NamesT Identity Term
    forall a. a -> NamesT Identity a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Term
    por NamesT Identity Term
    -> NamesT Identity Term -> NamesT Identity Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <#> NamesT Identity Term
    lvl
                                            NamesT Identity Term
    -> NamesT Identity Term -> NamesT Identity Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <@> NamesT Identity Term
    phi
                                            NamesT Identity Term
    -> NamesT Identity Term -> NamesT Identity Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <@> (Term -> NamesT Identity Term
    forall a. a -> NamesT Identity a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Term
    ineg NamesT Identity Term
    -> NamesT Identity Term -> NamesT Identity Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <@> NamesT Identity Term
    i)
                                            NamesT Identity Term
    -> NamesT Identity Term -> NamesT Identity Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <#> String
    -> (NamesT Identity Term -> NamesT Identity Term)
    -> NamesT Identity Term
    forall (m :: * -> *).
    Monad m =>
    String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
    lam String
    "_" (\ NamesT Identity Term
    o -> NamesT Identity Term
    rect)
                                            NamesT Identity Term
    -> NamesT Identity Term -> NamesT Identity Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <@> (NamesT Identity Term
    w NamesT Identity Term
    -> NamesT Identity Term -> NamesT Identity Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <@> (Term -> NamesT Identity Term
    forall a. a -> NamesT Identity a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Term
    imin NamesT Identity Term
    -> NamesT Identity Term -> NamesT Identity Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <@> NamesT Identity Term
    i NamesT Identity Term
    -> NamesT Identity Term -> NamesT Identity Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <@> NamesT Identity Term
    j))
                                            NamesT Identity Term
    -> NamesT Identity Term -> NamesT Identity Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <@> String
    -> (NamesT Identity Term -> NamesT Identity Term)
    -> NamesT Identity Term
    forall (m :: * -> *).
    Monad m =>
    String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
    lam String
    "_" (\ NamesT Identity Term
    o -> NamesT Identity Term
    w0) -- TODO wait for i = 0
                           )
              u0 <- w0
              pure $ Def theName [] `apply` (args ++ [argN psi, argN u, argN u0])

          -- (γ : Γ) ⊢ (flatten Φ)[n ↦ f_n (compR γ)]
          clause_types = [Term] -> Substitution
    forall a. DeBruijn a => [a] -> Substitution' a
    parallelS [Term
    compTerm Term -> QName -> Term
    `applyProj` (Arg QName -> QName
    forall e. Arg e -> e
    unArg Arg QName
    fn)
                                   | Arg QName
    fn <- [Arg QName] -> [Arg QName]
    forall a. [a] -> [a]
    reverse [Arg QName]
    fns] Substitution' (SubstArg [Dom LType]) -> [Dom LType] -> [Dom LType]
    forall a. Subst a => Substitution' (SubstArg a) -> a -> a
    `applySubst`
                           Tele (Dom LType) -> [Dom LType]
    forall a. TermSubst a => Tele (Dom a) -> [Dom a]
    flattenTel (Nat -> Substitution
    forall a. Nat -> Substitution' a
    raiseS (Tele (Dom Type) -> Nat
    forall a. Sized a => a -> Nat
    size Tele (Dom Type)
    gamma Nat -> Nat -> Nat
    forall a. Num a => a -> a -> a
    - Tele (Dom Type) -> Nat
    forall a. Sized a => a -> Nat
    size Tele (Dom Type)
    delta) Substitution' (SubstArg (Tele (Dom LType)))
    -> Tele (Dom LType) -> Tele (Dom LType)
    forall a. Subst a => Substitution' (SubstArg a) -> a -> a
    `applySubst` Tele (Dom LType)
    fsT) -- Γ, Φ ⊢ flatten Φ
          -- Δ ⊢ Φ = fsT
          -- Γ, i : I ⊢ Φ'
          fsT' = Nat -> Substitution
    forall a. Nat -> Substitution' a
    raiseS ((Tele (Dom Type) -> Nat
    forall a. Sized a => a -> Nat
    size Tele (Dom Type)
    gamma Nat -> Nat -> Nat
    forall a. Num a => a -> a -> a
    - Tele (Dom Type) -> Nat
    forall a. Sized a => a -> Nat
    size Tele (Dom Type)
    delta) Nat -> Nat -> Nat
    forall a. Num a => a -> a -> a
    + Nat
    1) Substitution' (SubstArg (Tele (Dom LType)))
    -> Tele (Dom LType) -> Tele (Dom LType)
    forall a. Subst a => Substitution' (SubstArg a) -> a -> a
    `applySubst` Tele (Dom LType)
    fsT

          -- Γ, i : I ⊢ (flatten Φ')[n ↦ f_n (fillR Γ i)]
          filled_types = [Term] -> Substitution
    forall a. DeBruijn a => [a] -> Substitution' a
    parallelS [Nat -> Term -> Term
    forall a. Subst a => Nat -> a -> a
    raise Nat
    1 Term
    fillTerm Term -> [Arg Term] -> Term
    forall t. Apply t => t -> [Arg Term] -> t
    `apply` [Term -> Arg Term
    forall e. e -> Arg e
    argN (Term -> Arg Term) -> Term -> Arg Term
    forall a b. (a -> b) -> a -> b
    $ Nat -> Term
    var Nat
    0] Term -> QName -> Term
    `applyProj` (Arg QName -> QName
    forall e. Arg e -> e
    unArg Arg QName
    fn)
                                   | Arg QName
    fn <- [Arg QName] -> [Arg QName]
    forall a. [a] -> [a]
    reverse [Arg QName]
    fns] Substitution' (SubstArg [Dom LType]) -> [Dom LType] -> [Dom LType]
    forall a. Subst a => Substitution' (SubstArg a) -> a -> a
    `applySubst`
                           Tele (Dom LType) -> [Dom LType]
    forall a. TermSubst a => Tele (Dom a) -> [Dom a]
    flattenTel Tele (Dom LType)
    fsT' -- Γ, i : I, Φ' ⊢ flatten Φ'

      comp <- do
            let
              imax NamesT Identity Term
    i NamesT Identity Term
    j = Term -> NamesT Identity Term
    forall a. a -> NamesT Identity a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Term
    tIMax NamesT Identity Term
    -> NamesT Identity Term -> NamesT Identity Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <@> NamesT Identity Term
    i NamesT Identity Term
    -> NamesT Identity Term -> NamesT Identity Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <@> NamesT Identity Term
    j
            let forward NamesT Identity Term
    la NamesT Identity Term
    bA NamesT Identity Term
    r NamesT Identity Term
    u = Term -> NamesT Identity Term
    forall a. a -> NamesT Identity a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Term
    transp NamesT Identity Term
    -> NamesT Identity Term -> NamesT Identity Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <#> String
    -> (NamesT Identity Term -> NamesT Identity Term)
    -> NamesT Identity Term
    forall (m :: * -> *).
    Monad m =>
    String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
    lam String
    "i" (\ NamesT Identity Term
    i -> NamesT Identity Term
    la NamesT Identity Term
    -> NamesT Identity Term -> NamesT Identity Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <@> (NamesT Identity Term
    i NamesT Identity Term
    -> NamesT Identity Term -> NamesT Identity Term
    `imax` NamesT Identity Term
    r))
                                                NamesT Identity Term
    -> NamesT Identity Term -> NamesT Identity Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <@> String
    -> (NamesT Identity Term -> NamesT Identity Term)
    -> NamesT Identity Term
    forall (m :: * -> *).
    Monad m =>
    String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
    lam String
    "i" (\ NamesT Identity Term
    i -> NamesT Identity Term
    bA NamesT Identity Term
    -> NamesT Identity Term -> NamesT Identity Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <@> (NamesT Identity Term
    i NamesT Identity Term
    -> NamesT Identity Term -> NamesT Identity Term
    `imax` NamesT Identity Term
    r))
                                                NamesT Identity Term
    -> NamesT Identity Term -> NamesT Identity Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <@> NamesT Identity Term
    r
                                                NamesT Identity Term
    -> NamesT Identity Term -> NamesT Identity Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <@> NamesT Identity Term
    u
            return $ \ NamesT Identity Term
    la NamesT Identity Term
    bA NamesT Identity Term
    phi NamesT Identity Term
    u NamesT Identity Term
    u0 ->
              Term -> NamesT Identity Term
    forall a. a -> NamesT Identity a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Term
    hcomp NamesT Identity Term
    -> NamesT Identity Term -> NamesT Identity Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <#> (NamesT Identity Term
    la NamesT Identity Term
    -> NamesT Identity Term -> NamesT Identity Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <@> Term -> NamesT Identity Term
    forall a. a -> NamesT Identity a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Term
    io) NamesT Identity Term
    -> NamesT Identity Term -> NamesT Identity Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <#> (NamesT Identity Term
    bA NamesT Identity Term
    -> NamesT Identity Term -> NamesT Identity Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <@> Term -> NamesT Identity Term
    forall a. a -> NamesT Identity a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Term
    io) NamesT Identity Term
    -> NamesT Identity Term -> NamesT Identity Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <#> NamesT Identity Term
    phi
                          NamesT Identity Term
    -> NamesT Identity Term -> NamesT Identity Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <@> String
    -> (NamesT Identity Term -> NamesT Identity Term)
    -> NamesT Identity Term
    forall (m :: * -> *).
    Monad m =>
    String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
    lam String
    "i" (\ NamesT Identity Term
    i -> String
    -> (NamesT Identity Term -> NamesT Identity Term)
    -> NamesT Identity Term
    forall (m :: * -> *).
    Monad m =>
    String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
    ilam String
    "o" ((NamesT Identity Term -> NamesT Identity Term)
     -> NamesT Identity Term)
    -> (NamesT Identity Term -> NamesT Identity Term)
    -> NamesT Identity Term
    forall a b. (a -> b) -> a -> b
    $ \ NamesT Identity Term
    o ->
                                  NamesT Identity Term
    -> NamesT Identity Term
    -> NamesT Identity Term
    -> NamesT Identity Term
    -> NamesT Identity Term
    forward NamesT Identity Term
    la NamesT Identity Term
    bA NamesT Identity Term
    i (NamesT Identity Term
    u NamesT Identity Term
    -> NamesT Identity Term -> NamesT Identity Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <@> NamesT Identity Term
    i NamesT Identity Term
    -> NamesT Identity Term -> NamesT Identity Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <..> NamesT Identity Term
    o))
                          NamesT Identity Term
    -> NamesT Identity Term -> NamesT Identity Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <@> NamesT Identity Term
    -> NamesT Identity Term
    -> NamesT Identity Term
    -> NamesT Identity Term
    -> NamesT Identity Term
    forward NamesT Identity Term
    la NamesT Identity Term
    bA (Term -> NamesT Identity Term
    forall a. a -> NamesT Identity a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Term
    iz) NamesT Identity Term
    u0
      let
          mkBody (Arg QName
    fname, Dom LType
    filled_ty') = do
            let
              proj :: NamesT Identity Term -> NamesT Identity Term
    proj NamesT Identity Term
    t = (Term -> QName -> Term
    `applyProj` Arg QName -> QName
    forall e. Arg e -> e
    unArg Arg QName
    fname) (Term -> Term) -> NamesT Identity Term -> NamesT Identity Term
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> NamesT Identity Term
    t
              filled_ty :: Term
    filled_ty = ArgInfo -> Abs Term -> Term
    Lam ArgInfo
    defaultArgInfo (String -> Term -> Abs Term
    forall a. String -> a -> Abs a
    Abs String
    "i" (Term -> Abs Term) -> Term -> Abs Term
    forall a b. (a -> b) -> a -> b
    $ (Type -> Term
    forall t a. Type'' t a -> a
    unEl (Type -> Term) -> (Dom LType -> Type) -> Dom LType -> Term
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . LType -> Type
    fromLType (LType -> Type) -> (Dom LType -> LType) -> Dom LType -> Type
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Dom LType -> LType
    forall t e. Dom' t e -> e
    unDom) Dom LType
    filled_ty')
              -- Γ ⊢ l : I -> Level of filled_ty
            l <- Level -> TCMT IO Level
    forall a (m :: * -> *). (Reduce a, MonadReduce m) => a -> m a
    reduce (Level -> TCMT IO Level) -> Level -> TCMT IO Level
    forall a b. (a -> b) -> a -> b
    $ LType -> Level
    lTypeLevel (LType -> Level) -> LType -> Level
    forall a b. (a -> b) -> a -> b
    $ Dom LType -> LType
    forall t e. Dom' t e -> e
    unDom Dom LType
    filled_ty'
            let lvl = ArgInfo -> Abs Term -> Term
    Lam ArgInfo
    defaultArgInfo (String -> Term -> Abs Term
    forall a. String -> a -> Abs a
    Abs String
    "i" (Term -> Abs Term) -> Term -> Abs Term
    forall a b. (a -> b) -> a -> b
    $ Level -> Term
    Level Level
    l)
            return $ runNames [] $ do
                 lvl       <- open lvl
                 phi       <- open the_phi
                 w         <- open the_u
                 w0        <- open the_u0
                 filled_ty <- open filled_ty

                 comp lvl
                      filled_ty
                      phi
                      (lam "i" $ \ NamesT Identity Term
    i -> String
    -> (NamesT Identity Term -> NamesT Identity Term)
    -> NamesT Identity Term
    forall (m :: * -> *).
    Monad m =>
    String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
    ilam String
    "o" ((NamesT Identity Term -> NamesT Identity Term)
     -> NamesT Identity Term)
    -> (NamesT Identity Term -> NamesT Identity Term)
    -> NamesT Identity Term
    forall a b. (a -> b) -> a -> b
    $ \ NamesT Identity Term
    o -> NamesT Identity Term -> NamesT Identity Term
    proj (NamesT Identity Term -> NamesT Identity Term)
    -> NamesT Identity Term -> NamesT Identity Term
    forall a b. (a -> b) -> a -> b
    $ NamesT Identity Term
    w NamesT Identity Term
    -> NamesT Identity Term -> NamesT Identity Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <@> NamesT Identity Term
    i NamesT Identity Term
    -> NamesT Identity Term -> NamesT Identity Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <..> NamesT Identity Term
    o) -- TODO wait for phi = 1
                      (proj w0)

      reportSDoc "hcomp.rec" 60 $ text $ "filled_types sorts:" ++ show (map (getSort . fromLType . unDom) filled_types)

      bodys <- mapM mkBody (zip fns filled_types)
      return $ ((theName, gamma, rtype, map (fmap fromLType) clause_types, bodys),IdS)

    getGeneralizedParameters :: Set Name -> QName -> TCM [Maybe Name]
    getGeneralizedParameters :: Set Name -> QName -> TCM [Maybe Name]
    getGeneralizedParameters Set Name
    gpars QName
    name | Set Name -> Bool
    forall a. Set a -> Bool
    Set.null Set Name
    gpars = [Maybe Name] -> TCM [Maybe Name]
    forall a. a -> TCMT IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return []
    getGeneralizedParameters Set Name
    gpars QName
    name = do
      -- Drop the named parameters that shouldn't be in scope (if the user
      -- wrote a split data type)
      let inscope :: Name -> Maybe Name
    inscope Name
    x = Name
    x Name -> Maybe () -> Maybe Name
    forall a b. a -> Maybe b -> Maybe a
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ Bool -> Maybe ()
    forall b (m :: * -> *). (IsBool b, MonadPlus m) => b -> m ()
    guard (Name -> Set Name -> Bool
    forall a. Ord a => a -> Set a -> Bool
    Set.member Name
    x Set Name
    gpars)
      (Maybe Name -> Maybe Name) -> [Maybe Name] -> [Maybe Name]
    forall a b. (a -> b) -> [a] -> [b]
    map (Maybe Name -> (Name -> Maybe Name) -> Maybe Name
    forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Name -> Maybe Name
    inscope) ([Maybe Name] -> [Maybe Name])
    -> (Definition -> [Maybe Name]) -> Definition -> [Maybe Name]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Definition -> [Maybe Name]
    defGeneralizedParams (Definition -> [Maybe Name])
    -> TCMT IO Definition -> TCM [Maybe Name]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Definition -> TCMT IO Definition
    forall (m :: * -> *).
    (Functor m, HasConstInfo m, HasOptions m, ReadTCState m,
     MonadTCEnv m, MonadDebug m) =>
    Definition -> m Definition
    instantiateDef (Definition -> TCMT IO Definition)
    -> TCMT IO Definition -> TCMT IO Definition
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< QName -> TCMT IO Definition
    forall (m :: * -> *). HasConstInfo m => QName -> m Definition
    getConstInfo QName
    name)

    -- | Bind the named generalized parameters.
    bindGeneralizedParameters :: [Maybe Name] -> Type -> (Telescope -> Type -> TCM a) -> TCM a
    bindGeneralizedParameters :: forall a.
    [Maybe Name] -> Type -> (Tele (Dom Type) -> Type -> TCM a) -> TCM a
    bindGeneralizedParameters [] Type
    t Tele (Dom Type) -> Type -> TCM a
    ret = Tele (Dom Type) -> Type -> TCM a
    ret Tele (Dom Type)
    forall a. Tele a
    EmptyTel Type
    t
    bindGeneralizedParameters (Maybe Name
    name : [Maybe Name]
    names) Type
    t Tele (Dom Type) -> Type -> TCM a
    ret =
      case Type -> Term
    forall t a. Type'' t a -> a
    unEl Type
    t of
        Pi Dom Type
    a Abs Type
    b -> TCM a -> TCM a
    ext (TCM a -> TCM a) -> TCM a -> TCM a
    forall a b. (a -> b) -> a -> b
    $ [Maybe Name] -> Type -> (Tele (Dom Type) -> Type -> TCM a) -> TCM a
    forall a.
    [Maybe Name] -> Type -> (Tele (Dom Type) -> Type -> TCM a) -> TCM a
    bindGeneralizedParameters [Maybe Name]
    names (Abs Type -> Type
    forall a. Abs a -> a
    unAbs Abs Type
    b) ((Tele (Dom Type) -> Type -> TCM a) -> TCM a)
    -> (Tele (Dom Type) -> Type -> TCM a) -> TCM a
    forall a b. (a -> b) -> a -> b
    $ \ Tele (Dom Type)
    tel Type
    t -> Tele (Dom Type) -> Type -> TCM a
    ret (Dom Type -> Abs (Tele (Dom Type)) -> Tele (Dom Type)
    forall a. a -> Abs (Tele a) -> Tele a
    ExtendTel Dom Type
    a (Tele (Dom Type)
    tel Tele (Dom Type) -> Abs Type -> Abs (Tele (Dom Type))
    forall a b. a -> Abs b -> Abs a
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ Abs Type
    b)) Type
    t
          where
            ext :: TCM a -> TCM a
    ext | Just Name
    x <- Maybe Name
    name = (Name, Dom Type) -> TCM a -> TCM a
    forall b (m :: * -> *) a.
    (AddContext b, MonadAddContext m) =>
    b -> m a -> m a
    forall (m :: * -> *) a.
    MonadAddContext m =>
    (Name, Dom Type) -> m a -> m a
    addContext (Name
    x, Dom Type
    a)
                | Bool
    otherwise      = (String, Dom Type) -> TCM a -> TCM a
    forall b (m :: * -> *) a.
    (AddContext b, MonadAddContext m) =>
    b -> m a -> m a
    forall (m :: * -> *) a.
    MonadAddContext m =>
    (String, Dom Type) -> m a -> m a
    addContext (Abs Type -> String
    forall a. Abs a -> String
    absName Abs Type
    b, Dom Type
    a)
        Term
    _      -> TCM a
    forall a. HasCallStack => a
    __IMPOSSIBLE__

    -- | Bind the parameters of a datatype.
    --
    --   We allow omission of hidden parameters at the definition site.
    --   Example:
    --   @
    --     data D {a} (A : Set a) : Set a
    --     data D A where
    --       c : A -> D A
    --   @

    bindParameters
      :: Int            -- ^ Number of parameters
      -> [A.LamBinding] -- ^ Bindings from definition site.
      -> Type           -- ^ Pi-type of bindings coming from signature site.
      -> (Telescope -> Type -> TCM a)
         -- ^ Continuation, accepting parameter telescope and rest of type.
         --   The parameters are part of the context when the continutation is invoked.
      -> TCM a

    bindParameters :: forall a.
    Nat
    -> [LamBinding]
    -> Type
    -> (Tele (Dom Type) -> Type -> TCM a)
    -> TCM a
    bindParameters Nat
    0 [] Type
    a Tele (Dom Type) -> Type -> TCM a
    ret = Tele (Dom Type) -> Type -> TCM a
    ret Tele (Dom Type)
    forall a. Tele a
    EmptyTel Type
    a

    bindParameters Nat
    0 (LamBinding
    par : [LamBinding]
    _) Type
    _ Tele (Dom Type) -> Type -> TCM a
    _ = LamBinding -> TCM a -> TCM a
    forall (m :: * -> *) x a.
    (MonadTrace m, HasRange x) =>
    x -> m a -> m a
    setCurrentRange LamBinding
    par (TCM a -> TCM a) -> TCM a -> TCM a
    forall a b. (a -> b) -> a -> b
    $
      TypeError -> TCM a
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCError m) =>
    TypeError -> m a
    typeError (TypeError -> TCM a) -> TypeError -> TCM a
    forall a b. (a -> b) -> a -> b
    $ LamBinding -> TypeError
    UnexpectedParameter LamBinding
    par

    bindParameters Nat
    npars [] Type
    t Tele (Dom Type) -> Type -> TCM a
    ret =
      case Type -> Term
    forall t a. Type'' t a -> a
    unEl Type
    t of
        Pi Dom Type
    a Abs Type
    b | Bool -> Bool
    forall a. Boolean a => a -> a
    not (Dom Type -> Bool
    forall a. LensHiding a => a -> Bool
    visible Dom Type
    a) -> do
                  x <- String -> TCMT IO Name
    forall a (m :: * -> *).
    (FreshName a, MonadFresh NameId m) =>
    a -> m Name
    forall (m :: * -> *). MonadFresh NameId m => String -> m Name
    freshName_ (Abs Type -> String
    forall a. Abs a -> String
    absName Abs Type
    b)
                  bindParameter npars [] x a b ret
               | Bool
    otherwise ->
                  TypeError -> TCM a
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCError m) =>
    TypeError -> m a
    typeError (TypeError -> TCM a) -> TypeError -> TCM a
    forall a b. (a -> b) -> a -> b
    $ Dom Type -> Abs Type -> TypeError
    ExpectedBindingForParameter Dom Type
    a Abs Type
    b
        Term
    _ -> TCM a
    forall a. HasCallStack => a
    __IMPOSSIBLE__

    bindParameters Nat
    npars par :: [LamBinding]
    par@(A.DomainFull (A.TBind Range
    _ TypedBindingInfo
    _ List1 (NamedArg Binder)
    xs Type
    e) : [LamBinding]
    bs) Type
    a Tele (Dom Type) -> Type -> TCM a
    ret =
      [LamBinding] -> TCM a -> TCM a
    forall (m :: * -> *) x a.
    (MonadTrace m, HasRange x) =>
    x -> m a -> m a
    setCurrentRange [LamBinding]
    par (TCM a -> TCM a) -> TCM a -> TCM a
    forall a b. (a -> b) -> a -> b
    $
      TypeError -> TCM a
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCError m) =>
    TypeError -> m a
    typeError (TypeError -> TCM a) -> TypeError -> TCM a
    forall a b. (a -> b) -> a -> b
    $ List1 (NamedArg Binder) -> TypeError
    UnexpectedTypeSignatureForParameter List1 (NamedArg Binder)
    xs

    bindParameters Nat
    _ (A.DomainFull A.TLet{} : [LamBinding]
    _) Type
    _ Tele (Dom Type) -> Type -> TCM a
    _ = TCM a
    forall a. HasCallStack => a
    __IMPOSSIBLE__

    bindParameters Nat
    _ (par :: LamBinding
    par@(A.DomainFree TacticAttribute
    _ NamedArg Binder
    arg) : [LamBinding]
    ps) Type
    _ Tele (Dom Type) -> Type -> TCM a
    _
      | NamedArg Binder -> Modality
    forall a. LensModality a => a -> Modality
    getModality NamedArg Binder
    arg Modality -> Modality -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Modality
    defaultModality = LamBinding -> TCM a -> TCM a
    forall (m :: * -> *) x a.
    (MonadTrace m, HasRange x) =>
    x -> m a -> m a
    setCurrentRange LamBinding
    par (TCM a -> TCM a) -> TCM a -> TCM a
    forall a b. (a -> b) -> a -> b
    $
          TypeError -> TCM a
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCError m) =>
    TypeError -> m a
    typeError (TypeError -> TCM a) -> TypeError -> TCM a
    forall a b. (a -> b) -> a -> b
    $ LamBinding -> TypeError
    UnexpectedModalityAnnotationInParameter LamBinding
    par

    bindParameters Nat
    npars ps0 :: [LamBinding]
    ps0@(par :: LamBinding
    par@(A.DomainFree TacticAttribute
    _ NamedArg Binder
    arg) : [LamBinding]
    ps) Type
    t Tele (Dom Type) -> Type -> TCM a
    ret = do
      let x :: Binder
    x          = NamedArg Binder -> Binder
    forall a. NamedArg a -> a
    namedArg NamedArg Binder
    arg
          TelV Tele (Dom Type)
    tel Type
    _ = Type -> TelV Type
    telView' Type
    t
      case NamedArg Binder -> [Dom' Term (String, Type)] -> ImplicitInsertion
    forall e a. NamedArg e -> [Dom a] -> ImplicitInsertion
    insertImplicit NamedArg Binder
    arg ([Dom' Term (String, Type)] -> ImplicitInsertion)
    -> [Dom' Term (String, Type)] -> ImplicitInsertion
    forall a b. (a -> b) -> a -> b
    $ Tele (Dom Type) -> [Dom' Term (String, Type)]
    forall t. Tele (Dom t) -> [Dom (String, t)]
    telToList Tele (Dom Type)
    tel of
        ImplicitInsertion
    NoInsertNeeded -> [LamBinding] -> Name -> TCM a
    continue [LamBinding]
    ps (Name -> TCM a) -> Name -> TCM a
    forall a b. (a -> b) -> a -> b
    $ BindName -> Name
    A.unBind (BindName -> Name) -> BindName -> Name
    forall a b. (a -> b) -> a -> b
    $ Binder -> BindName
    forall a. Binder' a -> a
    A.binderName Binder
    x
        ImpInsert [Dom ()]
    _    -> [LamBinding] -> Name -> TCM a
    continue [LamBinding]
    ps0 (Name -> TCM a) -> TCMT IO Name -> TCM a
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< String -> TCMT IO Name
    forall a (m :: * -> *).
    (FreshName a, MonadFresh NameId m) =>
    a -> m Name
    forall (m :: * -> *). MonadFresh NameId m => String -> m Name
    freshName_ (Abs Type -> String
    forall a. Abs a -> String
    absName Abs Type
    b)
        ImplicitInsertion
    BadImplicits   -> LamBinding -> TCM a -> TCM a
    forall (m :: * -> *) x a.
    (MonadTrace m, HasRange x) =>
    x -> m a -> m a
    setCurrentRange LamBinding
    par (TCM a -> TCM a) -> TCM a -> TCM a
    forall a b. (a -> b) -> a -> b
    $
          TypeError -> TCM a
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCError m) =>
    TypeError -> m a
    typeError (TypeError -> TCM a) -> TypeError -> TCM a
    forall a b. (a -> b) -> a -> b
    $ LamBinding -> TypeError
    UnexpectedParameter LamBinding
    par
        NoSuchName String
    x   -> LamBinding -> TCM a -> TCM a
    forall (m :: * -> *) x a.
    (MonadTrace m, HasRange x) =>
    x -> m a -> m a
    setCurrentRange LamBinding
    par (TCM a -> TCM a) -> TCM a -> TCM a
    forall a b. (a -> b) -> a -> b
    $
          TypeError -> TCM a
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCError m) =>
    TypeError -> m a
    typeError (TypeError -> TCM a) -> TypeError -> TCM a
    forall a b. (a -> b) -> a -> b
    $ String -> TypeError
    NoParameterOfName String
    x
      where
        Pi 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 Type
    b = Type -> Term
    forall t a. Type'' t a -> a
    unEl Type
    t -- TODO:: Defined but not used: info', a
        continue :: [LamBinding] -> Name -> TCM a
    continue [LamBinding]
    ps Name
    x = Nat
    -> [LamBinding]
    -> Name
    -> Dom Type
    -> Abs Type
    -> (Tele (Dom Type) -> Type -> TCM a)
    -> TCM a
    forall a.
    Nat
    -> [LamBinding]
    -> Name
    -> Dom Type
    -> Abs Type
    -> (Tele (Dom Type) -> Type -> TCM a)
    -> TCM a
    bindParameter Nat
    npars [LamBinding]
    ps Name
    x Dom Type
    dom Abs Type
    b Tele (Dom Type) -> Type -> TCM a
    ret

    bindParameter :: Int -> [A.LamBinding] -> Name -> Dom Type -> Abs Type -> (Telescope -> Type -> TCM a) -> TCM a
    bindParameter :: forall a.
    Nat
    -> [LamBinding]
    -> Name
    -> Dom Type
    -> Abs Type
    -> (Tele (Dom Type) -> Type -> TCM a)
    -> TCM a
    bindParameter Nat
    npars [LamBinding]
    ps Name
    x Dom Type
    a Abs Type
    b Tele (Dom Type) -> Type -> TCM a
    ret =
      (Name, Dom Type) -> TCM a -> TCM a
    forall b (m :: * -> *) a.
    (AddContext b, MonadAddContext m) =>
    b -> m a -> m a
    forall (m :: * -> *) a.
    MonadAddContext m =>
    (Name, Dom Type) -> m a -> m a
    addContext (Name
    x, Dom Type
    a) (TCM a -> TCM a) -> TCM a -> TCM a
    forall a b. (a -> b) -> a -> b
    $
        Nat
    -> [LamBinding]
    -> Type
    -> (Tele (Dom Type) -> Type -> TCM a)
    -> TCM a
    forall a.
    Nat
    -> [LamBinding]
    -> Type
    -> (Tele (Dom Type) -> Type -> TCM a)
    -> TCM a
    bindParameters (Nat
    npars Nat -> Nat -> Nat
    forall a. Num a => a -> a -> a
    - Nat
    1) [LamBinding]
    ps (Abs Type -> Type
    forall a. Subst a => Abs a -> a
    absBody Abs Type
    b) ((Tele (Dom Type) -> Type -> TCM a) -> TCM a)
    -> (Tele (Dom Type) -> Type -> TCM a) -> TCM a
    forall a b. (a -> b) -> a -> b
    $ \ Tele (Dom Type)
    tel Type
    s ->
          Tele (Dom Type) -> Type -> TCM a
    ret (Dom Type -> Abs (Tele (Dom Type)) -> Tele (Dom Type)
    forall a. a -> Abs (Tele a) -> Tele a
    ExtendTel Dom Type
    a (Abs (Tele (Dom Type)) -> Tele (Dom Type))
    -> Abs (Tele (Dom Type)) -> Tele (Dom Type)
    forall a b. (a -> b) -> a -> b
    $ String -> Tele (Dom Type) -> Abs (Tele (Dom Type))
    forall a. String -> a -> Abs a
    Abs (Name -> String
    nameToArgName Name
    x) Tele (Dom Type)
    tel) Type
    s

    -- | Check that the arguments to a constructor fits inside the sort of the datatype.
    --   The third argument is the type of the constructor.
    --
    --   When @--without-K@ is active and the type is fibrant the
    --   procedure also checks that the type is usable at the current
    --   modality. See #4784 and #5434.
    --
    --   As a side effect, return the arity of the constructor.

    fitsIn :: DataOrRecord_ -> QName -> UniverseCheck -> [IsForced] -> Type -> Sort -> TCM Int
    fitsIn :: DataOrRecord_
    -> QName
    -> UniverseCheck
    -> [IsForced]
    -> Type
    -> Sort' Term
    -> TCMT IO Nat
    fitsIn DataOrRecord_
    dataOrRecord QName
    con UniverseCheck
    uc [IsForced]
    forceds Type
    conT Sort' Term
    s = do
      String -> Nat -> TCMT IO Doc -> TCM ()
    forall (m :: * -> *).
    MonadDebug m =>
    String -> Nat -> TCMT IO Doc -> m ()
    reportSDoc String
    "tc.data.fits" Nat
    10 (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
    sep [ TCMT IO Doc
    "does" 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
    conT
            , TCMT IO Doc
    "of sort" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> Sort' Term -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    forall (m :: * -> *). MonadPretty m => Sort' Term -> m Doc
    prettyTCM (Type -> Sort' Term
    forall a. LensSort a => a -> Sort' Term
    getSort Type
    conT)
            , TCMT IO Doc
    "fit in" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> 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 TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> TCMT IO Doc
    "?"
            ]
      -- The code below would be simpler, but doesn't allow datatypes
      -- to be indexed by the universe level.
      -- s' <- instantiateFull (getSort t)
      -- noConstraints $ s' `leqSort` s

      TCMT IO Bool -> TCM () -> TCM ()
    forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
    whenM TCMT IO Bool
    forall (m :: * -> *). HasOptions m => m Bool
    withoutKOption (TCM () -> TCM ()) -> TCM () -> TCM ()
    forall a b. (a -> b) -> a -> b
    $ do
        q <- Lens' TCEnv Quantity -> TCMT IO Quantity
    forall (m :: * -> *) a. MonadTCEnv m => Lens' TCEnv a -> m a
    viewTC (Quantity -> f Quantity) -> TCEnv -> f TCEnv
    Lens' TCEnv Quantity
    eQuantity
        -- Don't want to check polarities for the constructor's type,
        -- only for its argument telescope!
        applyPolarityToContext (withStandardLock UnusedPolarity) $
          usableAtModality' (Just s) ConstructorType (setQuantity q unitModality) (unEl conT)

      li <- PragmaOptions -> Bool
    optLargeIndices (PragmaOptions -> Bool) -> TCMT IO PragmaOptions -> TCMT IO Bool
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> TCMT IO PragmaOptions
    forall (m :: * -> *). HasOptions m => m PragmaOptions
    pragmaOptions
      -- To allow propositional squash in data constructors, we turn @Prop ℓ@ into @Set ℓ@
      -- for the purpose of checking the sort of the constructor.
      -- This would be invalid for record constructors as we could unsquash
      -- by projecting out the squashed data.
      fitsIn' li forceds conT s $ applyWhen (dataOrRecord == IsData) propToType s
      where
      fitsIn' ::
           Bool        -- Are large indices allowed?
        -> [IsForced]  -- Which constructor arguments are forced?
        -> Type        -- Type of the constructor.
        -> Sort        -- Original sort of the data or record type.
        -> Sort        -- For @data@, prop-to-type converted sort.
        -> TCM Int     -- Constructor arity computed from the type.
      fitsIn' :: Bool
    -> [IsForced] -> Type -> Sort' Term -> Sort' Term -> TCMT IO Nat
    fitsIn' Bool
    li [IsForced]
    forceds Type
    t Sort' Term
    s0 Sort' Term
    s = do
        vt <- do
          t <- Type -> TCMT IO (Either (Dom Type, Abs Type) Type)
    forall (m :: * -> *).
    PureTCM m =>
    Type -> m (Either (Dom Type, Abs Type) Type)
    pathViewAsPi Type
    t
          return $ case t of
                        Left (Dom Type
    a,Abs Type
    b)     -> (Bool, Dom Type, Abs Type) -> Maybe (Bool, Dom Type, Abs Type)
    forall a. a -> Maybe a
    Just (Bool
    True ,Dom Type
    a,Abs Type
    b)
                        Right (El Sort' Term
    _ Term
    t) | Pi Dom Type
    a Abs Type
    b <- Term
    t
                                       -> (Bool, Dom Type, Abs Type) -> Maybe (Bool, Dom Type, Abs Type)
    forall a. a -> Maybe a
    Just (Bool
    False,Dom Type
    a,Abs Type
    b)
                        Either (Dom Type, Abs Type) Type
    _              -> Maybe (Bool, Dom Type, Abs Type)
    forall a. Maybe a
    Nothing
        case vt of
          Just (Bool
    isPath, Dom Type
    dom, Abs Type
    b) -> do
            polarity <- PragmaOptions -> Bool
    optPolarity (PragmaOptions -> Bool) -> TCMT IO PragmaOptions -> TCMT IO Bool
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> TCMT IO PragmaOptions
    forall (m :: * -> *). HasOptions m => m PragmaOptions
    pragmaOptions
            -- When the --polarity option is enabled, the type of
            -- every constructor argument is re-checked using the internal
            -- type checker, to ensure that their usage of datatype parameters is
            -- consistent with polarity annotations (of the parameters).
            -- This may impact type checking performance, as the internal checker
            -- does more work than just checking polarity.
            -- A simpler check dedicated to polarity could be implemented,
            -- but would likely lead to duplicated logic.
            -- For further discussion on why this check is necessary, see:
            -- https://github.com/agda/agda/pull/6385#issuecomment-1349672456
            when polarity $ do
              arg <- instantiateFull (unEl (unDom dom))
              reportSDoc "tc.polarity" 40 $
                sep [ "checking constructor domain"
                    , prettyTCM (unEl $ unDom dom)
                    , "("
                    , prettyTCM (show arg)
                    , ")"
                    , "against sort"
                    , prettyTCM (getSort dom)
                    ]
              checkInternal arg CmpLeq (sort (getSort dom))
            let
              (forced, forceds') = nextIsForced forceds
              isf = IsForced -> Bool
    isForced IsForced
    forced

            unless (isf && li) $ do
              sa <- reduce $ getSort dom
              unless (isPath || uc == NoUniverseCheck || sa == SizeUniv) $
                traceCall (CheckConArgFitsIn con isf (unDom dom) s) $
                fitSort sa s0 s

            addContext (absName b, dom) $ do
              succ <$> fitsIn' li forceds' (absBody b) (raise 1 s0) (raise 1 s)
          Maybe (Bool, Dom Type, Abs Type)
    _ -> do
            Sort' Term -> Sort' Term -> Sort' Term -> TCM ()
    fitSort (Type -> Sort' Term
    forall a. LensSort a => a -> Sort' Term
    getSort Type
    t) Sort' Term
    s0 Sort' Term
    s
            Nat -> TCMT IO Nat
    forall a. a -> TCMT IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Nat
    0
      -- catch hard error from sort comparison to turn it into a soft error
      fitSort :: Sort' Term -> Sort' Term -> Sort' Term -> TCM ()
    fitSort Sort' Term
    sa Sort' Term
    s0 Sort' Term
    s = Sort' Term -> Sort' Term -> TCM ()
    forall (m :: * -> *).
    MonadConversion m =>
    Sort' Term -> Sort' Term -> m ()
    leqSort Sort' Term
    sa Sort' Term
    s TCM () -> (TCErr -> TCM ()) -> TCM ()
    forall a. TCM a -> (TCErr -> TCM a) -> TCM a
    forall e (m :: * -> *) a.
    MonadError e m =>
    m a -> (e -> m a) -> m a
    `catchError` \ TCErr
    err ->
        Warning -> TCM ()
    forall (m :: * -> *).
    (HasCallStack, MonadWarning m) =>
    Warning -> m ()
    warning (Warning -> TCM ()) -> Warning -> TCM ()
    forall a b. (a -> b) -> a -> b
    $ DataOrRecord_
    -> QName -> Sort' Term -> Sort' Term -> TCErr -> Warning
    ConstructorDoesNotFitInData DataOrRecord_
    dataOrRecord QName
    con Sort' Term
    sa Sort' Term
    s0 TCErr
    err

    -- | When --without-K is enabled, we should check that the sorts of
    --   the index types fit into the sort of the datatype.
    checkIndexSorts :: Sort -> Telescope -> TCM ()
    checkIndexSorts :: Sort' Term -> Tele (Dom Type) -> TCM ()
    checkIndexSorts Sort' Term
    s = \case
      Tele (Dom Type)
    EmptyTel -> () -> TCM ()
    forall a. a -> TCMT IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
      ExtendTel Dom Type
    a Abs (Tele (Dom Type))
    tel' -> do
        let sa :: Sort' Term
    sa = Dom Type -> Sort' Term
    forall a. LensSort a => a -> Sort' Term
    getSort Dom Type
    a
        -- Andreas, 2020-10-19, allow Size indices
        Bool -> TCM () -> TCM ()
    forall b (m :: * -> *). (IsBool b, Monad m) => b -> m () -> m ()
    unless (Sort' Term
    sa Sort' Term -> Sort' Term -> Bool
    forall a. Eq a => a -> a -> Bool
    == Sort' Term
    forall t. Sort' t
    SizeUniv) (TCM () -> TCM ()) -> TCM () -> TCM ()
    forall a b. (a -> b) -> a -> b
    $ Sort' Term
    sa Sort' Term -> Sort' Term -> TCM ()
    forall (m :: * -> *).
    MonadConversion m =>
    Sort' Term -> Sort' Term -> m ()
    `leqSort` Sort' Term
    s
        Dom Type
    -> Abs (Tele (Dom Type)) -> (Tele (Dom Type) -> TCM ()) -> TCM ()
    forall a (m :: * -> *) b.
    (Subst a, MonadAddContext m) =>
    Dom Type -> Abs a -> (a -> m b) -> m b
    underAbstraction Dom Type
    a Abs (Tele (Dom Type))
    tel' ((Tele (Dom Type) -> TCM ()) -> TCM ())
    -> (Tele (Dom Type) -> TCM ()) -> TCM ()
    forall a b. (a -> b) -> a -> b
    $ Sort' Term -> Tele (Dom Type) -> TCM ()
    checkIndexSorts (Nat -> Sort' Term -> Sort' Term
    forall a. Subst a => Nat -> a -> a
    raise Nat
    1 Sort' Term
    s)

    -- | Return the parameters that share variables with the indices
    -- nonLinearParameters :: Int -> Type -> TCM [Int]
    -- nonLinearParameters nPars t =

    data IsPathCons = PathCons | PointCons
      deriving (IsPathCons -> IsPathCons -> Bool
    (IsPathCons -> IsPathCons -> Bool)
    -> (IsPathCons -> IsPathCons -> Bool) -> Eq IsPathCons
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: IsPathCons -> IsPathCons -> Bool
    == :: IsPathCons -> IsPathCons -> Bool
    $c/= :: IsPathCons -> IsPathCons -> Bool
    /= :: IsPathCons -> IsPathCons -> Bool
    Eq,Nat -> IsPathCons -> String -> String
    [IsPathCons] -> String -> String
    IsPathCons -> String
    (Nat -> IsPathCons -> String -> String)
    -> (IsPathCons -> String)
    -> ([IsPathCons] -> String -> String)
    -> Show IsPathCons
    forall a.
    (Nat -> a -> String -> String)
    -> (a -> String) -> ([a] -> String -> String) -> Show a
    $cshowsPrec :: Nat -> IsPathCons -> String -> String
    showsPrec :: Nat -> IsPathCons -> String -> String
    $cshow :: IsPathCons -> String
    show :: IsPathCons -> String
    $cshowList :: [IsPathCons] -> String -> String
    showList :: [IsPathCons] -> String -> String
    Show)

    -- | Check that a type constructs something of the given datatype. The first
    --   argument is the number of parameters to the datatype and the second the
    --   number of additional non-parameters in the context (1 when generalizing, 0
    --   otherwise).
    --
    constructs :: Int -> Int -> Type -> QName -> TCM IsPathCons
    constructs :: Nat -> Nat -> Type -> QName -> TCM IsPathCons
    constructs Nat
    nofPars Nat
    nofExtraVars Type
    t QName
    q = Nat -> Type -> TCM IsPathCons
    constrT Nat
    nofExtraVars Type
    t
        where
            -- The number n counts the proper (non-parameter) constructor arguments.
            constrT :: Nat -> Type -> TCM IsPathCons
            constrT :: Nat -> Type -> TCM IsPathCons
    constrT Nat
    n Type
    t = do
                t <- Type -> TCMT IO Type
    forall a (m :: * -> *). (Reduce a, MonadReduce m) => a -> m a
    reduce Type
    t
                pathV <- pathViewAsPi'whnf
                case unEl t of
                    Pi Dom Type
    _ (NoAbs String
    _ Type
    b)  -> Nat -> Type -> TCM IsPathCons
    constrT Nat
    n Type
    b
                    Pi Dom Type
    a Abs Type
    b            -> Dom Type -> Abs Type -> (Type -> TCM IsPathCons) -> TCM IsPathCons
    forall a (m :: * -> *) b.
    (Subst a, MonadAddContext m) =>
    Dom Type -> Abs a -> (a -> m b) -> m b
    underAbstraction Dom Type
    a Abs Type
    b ((Type -> TCM IsPathCons) -> TCM IsPathCons)
    -> (Type -> TCM IsPathCons) -> TCM IsPathCons
    forall a b. (a -> b) -> a -> b
    $ Nat -> Type -> TCM IsPathCons
    constrT (Nat
    n Nat -> Nat -> Nat
    forall a. Num a => a -> a -> a
    + Nat
    1)
                      -- OR: addCxtString (absName b) a $ constrT (n + 1) (absBody b)
                    Term
    _ | Left ((Dom Type
    a,Abs Type
    b),(Term, Term)
    _) <- Type -> Either ((Dom Type, Abs Type), (Term, Term)) Type
    pathV Type
    t -> do
                          _ <- case Abs Type
    b of
                                 NoAbs String
    _ Type
    b -> Nat -> Type -> TCM IsPathCons
    constrT Nat
    n Type
    b
                                 Abs Type
    b         -> Dom Type -> Abs Type -> (Type -> TCM IsPathCons) -> TCM IsPathCons
    forall a (m :: * -> *) b.
    (Subst a, MonadAddContext m) =>
    Dom Type -> Abs a -> (a -> m b) -> m b
    underAbstraction Dom Type
    a Abs Type
    b ((Type -> TCM IsPathCons) -> TCM IsPathCons)
    -> (Type -> TCM IsPathCons) -> TCM IsPathCons
    forall a b. (a -> b) -> a -> b
    $ Nat -> Type -> TCM IsPathCons
    constrT (Nat
    n Nat -> Nat -> Nat
    forall a. Num a => a -> a -> a
    + Nat
    1)
                          return PathCons
                    Def QName
    d [Elim' Term]
    es | QName
    d QName -> QName -> Bool
    forall a. Eq a => a -> a -> Bool
    == QName
    q -> do
                      let vs :: [Arg Term]
    vs = [Arg Term] -> Maybe [Arg Term] -> [Arg Term]
    forall a. a -> Maybe a -> a
    fromMaybe [Arg Term]
    forall a. HasCallStack => a
    __IMPOSSIBLE__ (Maybe [Arg Term] -> [Arg Term]) -> Maybe [Arg Term] -> [Arg Term]
    forall a b. (a -> b) -> a -> b
    $ [Elim' Term] -> Maybe [Arg Term]
    forall a. [Elim' a] -> Maybe [Arg a]
    allApplyElims [Elim' Term]
    es
                      let ([Arg Term]
    pars, [Arg Term]
    ixs) = Nat -> [Arg Term] -> ([Arg Term], [Arg Term])
    forall a. Nat -> [a] -> ([a], [a])
    splitAt Nat
    nofPars [Arg Term]
    vs
                      -- check that the constructor parameters are the data parameters
                      Nat -> [Arg Term] -> TCM ()
    forall {m :: * -> *}.
    (MonadMetaSolver m, MonadWarning m, MonadStatistics m,
     MonadFresh ProblemId m, MonadFresh Nat m) =>
    Nat -> [Arg Term] -> m ()
    checkParams Nat
    n [Arg Term]
    pars
                      IsPathCons -> TCM IsPathCons
    forall a. a -> TCMT IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return IsPathCons
    PointCons
                    MetaV{} -> do
                      def <- QName -> TCMT IO Definition
    forall (m :: * -> *). HasConstInfo m => QName -> m Definition
    getConstInfo QName
    q
                      -- Analyse the type of q (name of the data type)
                      let td = Definition -> Type
    defType Definition
    def
                      TelV tel core <- telView td
                      -- Construct the parameter arguments
                      -- The parameters are @n + nofPars - 1 .. n@
                      let us = (Arg String -> Nat -> Arg Term)
    -> [Arg String] -> [Nat] -> [Arg Term]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith (\ Arg String
    arg Nat
    x -> Nat -> Term
    var Nat
    x Term -> Arg String -> Arg Term
    forall a b. a -> Arg b -> Arg a
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ Arg String
    arg ) (Tele (Dom Type) -> [Arg String]
    forall a. TelToArgs a => a -> [Arg String]
    telToArgs Tele (Dom Type)
    tel) ([Nat] -> [Arg Term]) -> [Nat] -> [Arg Term]
    forall a b. (a -> b) -> a -> b
    $
                                 Nat -> [Nat] -> [Nat]
    forall a. Nat -> [a] -> [a]
    take Nat
    nofPars ([Nat] -> [Nat]) -> [Nat] -> [Nat]
    forall a b. (a -> b) -> a -> b
    $ Nat -> [Nat]
    forall a. Integral a => a -> [a]
    downFrom (Nat
    nofPars Nat -> Nat -> Nat
    forall a. Num a => a -> a -> a
    + Nat
    n)
                      -- The indices are fresh metas
                      xs <- newArgsMeta =<< piApplyM td us
                      let t' = Sort' Term -> Term -> Type
    forall t a. Sort' t -> a -> Type'' t a
    El (Nat -> Sort' Term -> Sort' Term
    forall a. Subst a => Nat -> a -> a
    raise Nat
    n (Sort' Term -> Sort' Term) -> Sort' Term -> Sort' Term
    forall a b. (a -> b) -> a -> b
    $ Defn -> Sort' Term
    dataSort (Defn -> Sort' Term) -> Defn -> Sort' Term
    forall a b. (a -> b) -> a -> b
    $ Definition -> Defn
    theDef Definition
    def) (Term -> Type) -> Term -> Type
    forall a b. (a -> b) -> a -> b
    $ QName -> [Elim' Term] -> Term
    Def QName
    q ([Elim' Term] -> Term) -> [Elim' Term] -> Term
    forall a b. (a -> b) -> a -> b
    $ (Arg Term -> Elim' Term) -> [Arg Term] -> [Elim' Term]
    forall a b. (a -> b) -> [a] -> [b]
    map Arg Term -> Elim' Term
    forall a. Arg a -> Elim' a
    Apply ([Arg Term] -> [Elim' Term]) -> [Arg Term] -> [Elim' Term]
    forall a b. (a -> b) -> a -> b
    $ [Arg Term]
    us [Arg Term] -> [Arg Term] -> [Arg Term]
    forall a. [a] -> [a] -> [a]
    ++ [Arg Term]
    xs
                      -- Andreas, 2017-11-07, issue #2840
                      -- We should not postpone here, otherwise we might upset the positivity checker.
                      ifM (tryConversion $ equalType t t')
                          (constrT n t')
                          (typeError $ ShouldEndInApplicationOfTheDatatype t)
                    Term
    _ -> TypeError -> TCM IsPathCons
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCError m) =>
    TypeError -> m a
    typeError (TypeError -> TCM IsPathCons) -> TypeError -> TCM IsPathCons
    forall a b. (a -> b) -> a -> b
    $ Type -> TypeError
    ShouldEndInApplicationOfTheDatatype Type
    t

            checkParams :: Nat -> [Arg Term] -> m ()
    checkParams Nat
    n [Arg Term]
    vs = (Arg Term -> Nat -> m ()) -> [Arg Term] -> [Nat] -> m ()
    forall (m :: * -> *) a b c.
    Applicative m =>
    (a -> b -> m c) -> [a] -> [b] -> m ()
    zipWithM_ Arg Term -> Nat -> m ()
    forall {m :: * -> *}.
    (MonadMetaSolver m, MonadWarning m, MonadStatistics m,
     MonadFresh ProblemId m, MonadFresh Nat m) =>
    Arg Term -> Nat -> m ()
    sameVar [Arg Term]
    vs [Nat]
    ps
                where
                    nvs :: Nat
    nvs = [Arg Term] -> Nat
    forall a. [a] -> Nat
    forall (t :: * -> *) a. Foldable t => t a -> Nat
    length [Arg Term]
    vs
                    ps :: [Nat]
    ps  = [Nat] -> [Nat]
    forall a. [a] -> [a]
    reverse ([Nat] -> [Nat]) -> [Nat] -> [Nat]
    forall a b. (a -> b) -> a -> b
    $ Nat -> [Nat] -> [Nat]
    forall a. Nat -> [a] -> [a]
    take Nat
    nvs [Nat
    n..]

                    sameVar :: Arg Term -> Nat -> m ()
    sameVar Arg Term
    arg Nat
    i
                      -- skip irrelevant parameters
                      | Arg Term -> Bool
    forall a. LensRelevance a => a -> Bool
    isIrrelevant Arg Term
    arg = () -> m ()
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
                      | Bool
    otherwise = do
                        t <- Nat -> m Type
    forall (m :: * -> *). (MonadDebug m, MonadTCEnv m) => Nat -> m Type
    typeOfBV Nat
    i
                        equalTerm t (unArg arg) (var i)

    -- | Is the type coinductive? Returns 'Nothing' if the answer cannot
    -- be determined.

    isCoinductive :: Type -> TCM (Maybe Bool)
    isCoinductive :: Type -> TCM (Maybe Bool)
    isCoinductive Type
    t = do
      El s t <- Type -> TCMT IO Type
    forall a (m :: * -> *). (Reduce a, MonadReduce m) => a -> m a
    reduce Type
    t
      case t of
        Def QName
    q [Elim' Term]
    _ -> do
          def <- QName -> TCMT IO Definition
    forall (m :: * -> *). HasConstInfo m => QName -> m Definition
    getConstInfo QName
    q
          case theDef def of
            Axiom       {} -> Maybe Bool -> TCM (Maybe Bool)
    forall a. a -> TCMT IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool -> Maybe Bool
    forall a. a -> Maybe a
    Just Bool
    False)
            DataOrRecSig{} -> Maybe Bool -> TCM (Maybe Bool)
    forall a. a -> TCMT IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe Bool
    forall a. Maybe a
    Nothing
            Function    {} -> Maybe Bool -> TCM (Maybe Bool)
    forall a. a -> TCMT IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe Bool
    forall a. Maybe a
    Nothing
            Datatype    {} -> Maybe Bool -> TCM (Maybe Bool)
    forall a. a -> TCMT IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool -> Maybe Bool
    forall a. a -> Maybe a
    Just Bool
    False)
            Record      {  recInduction :: Defn -> Maybe Induction
    recInduction = Just Induction
    CoInductive } -> Maybe Bool -> TCM (Maybe Bool)
    forall a. a -> TCMT IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool -> Maybe Bool
    forall a. a -> Maybe a
    Just Bool
    True)
            Record      {  recInduction :: Defn -> Maybe Induction
    recInduction = Maybe Induction
    _                } -> Maybe Bool -> TCM (Maybe Bool)
    forall a. a -> TCMT IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool -> Maybe Bool
    forall a. a -> Maybe a
    Just Bool
    False)
            GeneralizableVar{} -> TCM (Maybe Bool)
    forall a. HasCallStack => a
    __IMPOSSIBLE__
            Constructor {} -> TCM (Maybe Bool)
    forall a. HasCallStack => a
    __IMPOSSIBLE__
            Primitive   {} -> TCM (Maybe Bool)
    forall a. HasCallStack => a
    __IMPOSSIBLE__
            PrimitiveSort{} -> TCM (Maybe Bool)
    forall a. HasCallStack => a
    __IMPOSSIBLE__
            AbstractDefn{} -> TCM (Maybe Bool)
    forall a. HasCallStack => a
    __IMPOSSIBLE__
        Var   {} -> Maybe Bool -> TCM (Maybe Bool)
    forall a. a -> TCMT IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe Bool
    forall a. Maybe a
    Nothing
        Lam   {} -> TCM (Maybe Bool)
    forall a. HasCallStack => a
    __IMPOSSIBLE__
        Lit   {} -> TCM (Maybe Bool)
    forall a. HasCallStack => a
    __IMPOSSIBLE__
        Level {} -> TCM (Maybe Bool)
    forall a. HasCallStack => a
    __IMPOSSIBLE__
        Con   {} -> TCM (Maybe Bool)
    forall a. HasCallStack => a
    __IMPOSSIBLE__
        Pi    {} -> Maybe Bool -> TCM (Maybe Bool)
    forall a. a -> TCMT IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool -> Maybe Bool
    forall a. a -> Maybe a
    Just Bool
    False)
        Sort  {} -> Maybe Bool -> TCM (Maybe Bool)
    forall a. a -> TCMT IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool -> Maybe Bool
    forall a. a -> Maybe a
    Just Bool
    False)
        MetaV {} -> Maybe Bool -> TCM (Maybe Bool)
    forall a. a -> TCMT IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe Bool
    forall a. Maybe a
    Nothing
        DontCare{} -> TCM (Maybe Bool)
    forall a. HasCallStack => a
    __IMPOSSIBLE__
        Dummy String
    s [Elim' Term]
    _  -> String -> TCM (Maybe Bool)
    forall (m :: * -> *) a.
    (HasCallStack, MonadDebug m) =>
    String -> m a
    __IMPOSSIBLE_VERBOSE__ String
    s