    {-# LANGUAGE NondecreasingIndentation #-}

    module Agda.TypeChecking.Primitive.Cubical
      ( module Agda.TypeChecking.Primitive.Cubical
      , module Agda.TypeChecking.Primitive.Cubical.Base
      , module Agda.TypeChecking.Primitive.Cubical.Glue
      , module Agda.TypeChecking.Primitive.Cubical.HCompU
      )
      where

    import Prelude hiding (null, (!!))

    import Control.Monad
    import Control.Monad.Except
    import Control.Monad.Trans ( lift )
    import Control.Exception

    import Data.String ()

    import Data.IntMap (IntMap)
    import qualified Data.IntMap as IntMap
    import qualified Data.List as List
    import Data.Foldable hiding (null)

    import Agda.Syntax.Common
    import Agda.Syntax.Internal
    import Agda.Syntax.Internal.Pattern
    import qualified Agda.Syntax.Common.Pretty as P

    import Agda.TypeChecking.Names
    import Agda.TypeChecking.Positivity.Occurrence
    import Agda.TypeChecking.Primitive.Base
    import Agda.TypeChecking.Monad

    import Agda.TypeChecking.Free
    import Agda.TypeChecking.Substitute
    import Agda.TypeChecking.Pretty
    import Agda.TypeChecking.Reduce
    import Agda.TypeChecking.Telescope

    import Agda.Utils.Either
    import Agda.Utils.Function
    import Agda.Utils.Functor

    import Agda.Utils.Impossible
    import Agda.Utils.Maybe
    import Agda.Utils.Null
    import Agda.Utils.Tuple
    import Agda.Utils.Size
    import Agda.Utils.BoolSet (BoolSet)
    import qualified Agda.Utils.BoolSet as BoolSet

    import Agda.TypeChecking.Primitive.Cubical.HCompU
    import Agda.TypeChecking.Primitive.Cubical.Glue
    import Agda.TypeChecking.Primitive.Cubical.Base

    primPOr :: TCM PrimitiveImpl
    primPOr :: TCM PrimitiveImpl
    primPOr = do
      Cubical -> TCM ()
    requireCubical Cubical
    CErased
      t    <- Names -> NamesT (TCMT IO) Type -> TCMT IO Type
    forall (m :: * -> *) a. Names -> NamesT m a -> m a
    runNamesT [] (NamesT (TCMT IO) Type -> TCMT IO Type)
    -> NamesT (TCMT IO) Type -> TCMT IO Type
    forall a b. (a -> b) -> a -> b
    $
              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
    hPi' String
    "a" (NamesT (TCMT IO) Sort
    -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
    forall (m :: * -> *). Applicative m => m Sort -> m Term -> m Type
    els (Sort -> NamesT (TCMT IO) Sort
    forall a. a -> NamesT (TCMT IO) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Sort
    forall t. Sort' t
    LevelUniv) (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
    primLevel))    ((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
    a  ->
              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 -> 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
    i  ->
              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
    "j" NamesT (TCMT IO) Type
    forall (m :: * -> *).
    (HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
    m Type
    primIntervalType ((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
    j  ->
              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
    hPi' String
    "A" (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
    -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
    forall (m :: * -> *). HasBuiltins m => m Term -> m Term -> m Term
    imax NamesT (TCMT IO) Term
    i NamesT (TCMT IO) Term
    j) ((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
    o -> NamesT (TCMT IO) Term
    -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Type
    el' (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
    primLevelSuc 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
    a) (Sort -> Term
    Sort (Sort -> Term) -> (Term -> Sort) -> Term -> Term
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Term -> Sort
    tmSort (Term -> Term) -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> NamesT (TCMT IO) Term
    a)) ((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
    bA ->
              ((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
    "i1" NamesT (TCMT IO) Term
    i ((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
    i1 -> NamesT (TCMT IO) Term
    -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Type
    el' NamesT (TCMT IO) Term
    a (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
    -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
    forall a b. (a -> b) -> a -> b
    $ NamesT (TCMT IO) Term
    bA NamesT (TCMT IO) Term
    -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <..> (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
    primIsOne1 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
    <@> NamesT (TCMT IO) Term
    i1))) NamesT (TCMT IO) Type
    -> NamesT (TCMT IO) Type -> NamesT (TCMT IO) Type
    forall (m :: * -> *). Applicative m => m Type -> m Type -> m Type
    -->
              ((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
    "j1" NamesT (TCMT IO) Term
    j ((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
    j1 -> NamesT (TCMT IO) Term
    -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Type
    el' NamesT (TCMT IO) Term
    a (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
    -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
    forall a b. (a -> b) -> a -> b
    $ NamesT (TCMT IO) Term
    bA NamesT (TCMT IO) Term
    -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <..> (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
    primIsOne2 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
    <@> NamesT (TCMT IO) Term
    j1))) NamesT (TCMT IO) Type
    -> NamesT (TCMT IO) Type -> NamesT (TCMT IO) Type
    forall (m :: * -> *). Applicative m => m Type -> m Type -> m Type
    -->
              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
    -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
    forall (m :: * -> *). HasBuiltins m => m Term -> m Term -> m Term
    imax NamesT (TCMT IO) Term
    i NamesT (TCMT IO) Term
    j) (\ NamesT (TCMT IO) Term
    o -> NamesT (TCMT IO) Term
    -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Type
    el' NamesT (TCMT IO) Term
    a (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
    -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
    forall a b. (a -> b) -> a -> b
    $ NamesT (TCMT IO) Term
    bA 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)
      return $ PrimImpl t $ primFun __IMPOSSIBLE__ 6 $ \ [Arg Term]
    ts -> do
        case [Arg Term]
    ts of
         [Arg Term
    l,Arg Term
    i,Arg Term
    j,Arg Term
    a,Arg Term
    u,Arg Term
    v] -> do
           si <- Arg Term -> ReduceM (Blocked (Arg Term))
    forall t. Reduce t => t -> ReduceM (Blocked t)
    reduceB' Arg Term
    i
           vi <- intervalView $ unArg $ ignoreBlocking si
           case vi of
            IntervalView
    IOne -> Term -> ReduceM (Reduced MaybeReducedArgs Term)
    forall a a'. a -> ReduceM (Reduced a' a)
    redReturn (Arg Term -> Term
    forall e. Arg e -> e
    unArg Arg Term
    u)
            IntervalView
    IZero -> Term -> ReduceM (Reduced MaybeReducedArgs Term)
    forall a a'. a -> ReduceM (Reduced a' a)
    redReturn (Arg Term -> Term
    forall e. Arg e -> e
    unArg Arg Term
    v)
            IntervalView
    _ -> do
              sj <- Arg Term -> ReduceM (Blocked (Arg Term))
    forall t. Reduce t => t -> ReduceM (Blocked t)
    reduceB' Arg Term
    j
              vj <- intervalView $ unArg $ ignoreBlocking sj
              case vj of
                IntervalView
    IOne -> Term -> ReduceM (Reduced MaybeReducedArgs Term)
    forall a a'. a -> ReduceM (Reduced a' a)
    redReturn (Arg Term -> Term
    forall e. Arg e -> e
    unArg Arg Term
    v)
                IntervalView
    IZero -> Term -> ReduceM (Reduced MaybeReducedArgs Term)
    forall a a'. a -> ReduceM (Reduced a' a)
    redReturn (Arg Term -> Term
    forall e. Arg e -> e
    unArg Arg Term
    u)
                IntervalView
    _ -> Reduced MaybeReducedArgs Term
    -> ReduceM (Reduced MaybeReducedArgs Term)
    forall a. a -> ReduceM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Reduced MaybeReducedArgs Term
     -> ReduceM (Reduced MaybeReducedArgs Term))
    -> Reduced MaybeReducedArgs Term
    -> ReduceM (Reduced MaybeReducedArgs Term)
    forall a b. (a -> b) -> a -> b
    $ MaybeReducedArgs -> Reduced MaybeReducedArgs Term
    forall no yes. no -> Reduced no yes
    NoReduction [Arg Term -> MaybeReduced (Arg Term)
    forall a. a -> MaybeReduced a
    notReduced Arg Term
    l,Blocked (Arg Term) -> MaybeReduced (Arg Term)
    reduced Blocked (Arg Term)
    si,Blocked (Arg Term) -> MaybeReduced (Arg Term)
    reduced Blocked (Arg Term)
    sj,Arg Term -> MaybeReduced (Arg Term)
    forall a. a -> MaybeReduced a
    notReduced Arg Term
    a,Arg Term -> MaybeReduced (Arg Term)
    forall a. a -> MaybeReduced a
    notReduced Arg Term
    u,Arg Term -> MaybeReduced (Arg Term)
    forall a. a -> MaybeReduced a
    notReduced Arg Term
    v]

         [Arg Term]
    _ -> ReduceM (Reduced MaybeReducedArgs Term)
    forall a. HasCallStack => a
    __IMPOSSIBLE__

    primPartial' :: TCM PrimitiveImpl
    primPartial' :: TCM PrimitiveImpl
    primPartial' = do
      Cubical -> TCM ()
    requireCubical Cubical
    CErased
      t <- Names -> NamesT (TCMT IO) Type -> TCMT IO Type
    forall (m :: * -> *) a. Names -> NamesT m a -> m a
    runNamesT [] (NamesT (TCMT IO) Type -> TCMT IO Type)
    -> NamesT (TCMT IO) Type -> TCMT IO Type
    forall a b. (a -> b) -> a -> b
    $
           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
    hPi' String
    "a" (NamesT (TCMT IO) Sort
    -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
    forall (m :: * -> *). Applicative m => m Sort -> m Term -> m Type
    els (Sort -> NamesT (TCMT IO) Sort
    forall a. a -> NamesT (TCMT IO) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Sort
    forall t. Sort' t
    LevelUniv) (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
    primLevel)) (\ NamesT (TCMT IO) Term
    a ->
            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
    "φ" NamesT (TCMT IO) Type
    forall (m :: * -> *).
    (HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
    m Type
    primIntervalType ((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
    _ ->
            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
    "A" (Sort -> Type
    sort (Sort -> Type) -> (Term -> Sort) -> Term -> Type
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Term -> Sort
    tmSort (Term -> Type) -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> NamesT (TCMT IO) Term
    a) ((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
    bA ->
            (Sort -> Type
    sort (Sort -> Type) -> (Term -> Sort) -> Term -> Type
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Term -> Sort
    tmSSort (Term -> Type) -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> NamesT (TCMT IO) Term
    a))
      isOne <- primIsOne
      v <- runNamesT [] $
            lam "a" $ \ NamesT (TCMT IO) Term
    l ->
            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
    "φ" ((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
    phi ->
            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
    "A" ((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
    a ->
            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
    <$> 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
    "p" NamesT (TCMT IO) Term
    phi (\NamesT (TCMT IO) Term
    _ -> NamesT (TCMT IO) Term
    -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Type
    el' NamesT (TCMT IO) Term
    l NamesT (TCMT IO) Term
    a)
      return $ PrimImpl t $ primFun __IMPOSSIBLE__ 0 $ \ [Arg Term]
    _ -> Term -> ReduceM (Reduced MaybeReducedArgs Term)
    forall a a'. a -> ReduceM (Reduced a' a)
    redReturn Term
    v

    primPartialP' :: TCM PrimitiveImpl
    primPartialP' :: TCM PrimitiveImpl
    primPartialP' = do
      Cubical -> TCM ()
    requireCubical Cubical
    CErased
      t <- Names -> NamesT (TCMT IO) Type -> TCMT IO Type
    forall (m :: * -> *) a. Names -> NamesT m a -> m a
    runNamesT [] (NamesT (TCMT IO) Type -> TCMT IO Type)
    -> NamesT (TCMT IO) Type -> TCMT IO Type
    forall a b. (a -> b) -> a -> b
    $
           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
    hPi' String
    "a" (NamesT (TCMT IO) Sort
    -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
    forall (m :: * -> *). Applicative m => m Sort -> m Term -> m Type
    els (Sort -> NamesT (TCMT IO) Sort
    forall a. a -> NamesT (TCMT IO) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Sort
    forall t. Sort' t
    LevelUniv) (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
    primLevel)) (\ NamesT (TCMT IO) Term
    a ->
            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
    "φ" NamesT (TCMT IO) Type
    forall (m :: * -> *).
    (HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
    m Type
    primIntervalType ((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
    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
    "A" (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) Term
    -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Type
    el' (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
    primLevelSuc 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
    a) (Sort -> Term
    Sort (Sort -> Term) -> (Term -> Sort) -> Term -> Term
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Term -> Sort
    tmSort (Term -> Term) -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> NamesT (TCMT IO) Term
    a)) ((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
    bA ->
            (Sort -> Type
    sort (Sort -> Type) -> (Term -> Sort) -> Term -> Type
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Term -> Sort
    tmSSort (Term -> Type) -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> NamesT (TCMT IO) Term
    a))
      v <- runNamesT [] $
            lam "a" $ \ NamesT (TCMT IO) Term
    l ->
            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
    "φ" ((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
    phi ->
            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
    "A" ((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
    a ->
            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
    <$> 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
    "p" NamesT (TCMT IO) Term
    phi (\ NamesT (TCMT IO) Term
    p -> NamesT (TCMT IO) Term
    -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Type
    el' NamesT (TCMT IO) Term
    l (NamesT (TCMT IO) Term
    a 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
    p))
      return $ PrimImpl t $ primFun __IMPOSSIBLE__ 0 $ \ [Arg Term]
    _ -> Term -> ReduceM (Reduced MaybeReducedArgs Term)
    forall a a'. a -> ReduceM (Reduced a' a)
    redReturn Term
    v

    primSubOut' :: TCM PrimitiveImpl
    primSubOut' :: TCM PrimitiveImpl
    primSubOut' = do
      Cubical -> TCM ()
    requireCubical Cubical
    CErased
      t    <- Names -> NamesT (TCMT IO) Type -> TCMT IO Type
    forall (m :: * -> *) a. Names -> NamesT m a -> m a
    runNamesT [] (NamesT (TCMT IO) Type -> TCMT IO Type)
    -> NamesT (TCMT IO) Type -> TCMT IO Type
    forall a b. (a -> b) -> a -> b
    $
              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
    hPi' String
    "a" (NamesT (TCMT IO) Sort
    -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
    forall (m :: * -> *). Applicative m => m Sort -> m Term -> m Type
    els (Sort -> NamesT (TCMT IO) Sort
    forall a. a -> NamesT (TCMT IO) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Sort
    forall t. Sort' t
    LevelUniv) (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
    primLevel)) ((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
    a ->
              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
    hPi' String
    "A" (NamesT (TCMT IO) Term
    -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Type
    el' (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
    primLevelSuc 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
    a) (Sort -> Term
    Sort (Sort -> Term) -> (Term -> Sort) -> Term -> Term
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Term -> Sort
    tmSort (Term -> Term) -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> NamesT (TCMT IO) Term
    a)) ((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
    bA ->
              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
    hPi' String
    "φ" NamesT (TCMT IO) Type
    forall (m :: * -> *).
    (HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
    m Type
    primIntervalType ((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
    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
    hPi' String
    "u" (NamesT (TCMT IO) Term
    -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Type
    el's NamesT (TCMT IO) Term
    a (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
    -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
    forall a b. (a -> b) -> a -> b
    $ 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
    primPartial 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
    a 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
    bA) ((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
    u ->
              NamesT (TCMT IO) Term
    -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Type
    el's NamesT (TCMT IO) Term
    a (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
    primSub 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
    a 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
    bA 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
    u) 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) Term
    -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Type
    el' NamesT (TCMT IO) Term
    a NamesT (TCMT IO) Term
    bA
      return $ PrimImpl t $ primFun __IMPOSSIBLE__ 5 $ \ [Arg Term]
    ts -> do
        case [Arg Term]
    ts of
          [Arg Term
    a,Arg Term
    bA,Arg Term
    phi,Arg Term
    u,Arg Term
    x] -> do
            view <- ReduceM (Term -> IntervalView)
    forall (m :: * -> *). HasBuiltins m => m (Term -> IntervalView)
    intervalView'
            sphi <- reduceB' phi
            case view $ unArg $ ignoreBlocking sphi of
              IntervalView
    IOne -> Term -> ReduceM (Reduced MaybeReducedArgs Term)
    forall a a'. a -> ReduceM (Reduced a' a)
    redReturn (Term -> ReduceM (Reduced MaybeReducedArgs Term))
    -> ReduceM Term -> ReduceM (Reduced MaybeReducedArgs Term)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< (Term -> ReduceM Term
    forall a. a -> ReduceM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Arg Term -> Term
    forall e. Arg e -> e
    unArg Arg Term
    u) ReduceM Term -> ReduceM Term -> ReduceM Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <..> String -> BuiltinId -> ReduceM Term
    forall (m :: * -> *) a.
    (HasBuiltins m, IsBuiltin a) =>
    String -> a -> m Term
    getTerm (PrimitiveId -> String
    forall a. IsBuiltin a => a -> String
    getBuiltinId PrimitiveId
    PrimSubOut) BuiltinId
    BuiltinItIsOne)
              IntervalView
    _ -> do
                sx <- Arg Term -> ReduceM (Blocked (Arg Term))
    forall t. Reduce t => t -> ReduceM (Blocked t)
    reduceB' Arg Term
    x
                mSubIn <- getBuiltinName' builtinSubIn
                case unArg $ ignoreBlocking $ sx of
                  Def QName
    q [Elim
    _,Elim
    _,Elim
    _, Apply Arg Term
    t] | QName -> Maybe QName
    forall a. a -> Maybe a
    Just QName
    q Maybe QName -> Maybe QName -> Bool
    forall a. Eq a => a -> a -> Bool
    == Maybe QName
    mSubIn -> Term -> ReduceM (Reduced MaybeReducedArgs Term)
    forall a a'. a -> ReduceM (Reduced a' a)
    redReturn (Arg Term -> Term
    forall e. Arg e -> e
    unArg Arg Term
    t)
                  Term
    _ -> Reduced MaybeReducedArgs Term
    -> ReduceM (Reduced MaybeReducedArgs Term)
    forall a. a -> ReduceM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Reduced MaybeReducedArgs Term
     -> ReduceM (Reduced MaybeReducedArgs Term))
    -> Reduced MaybeReducedArgs Term
    -> ReduceM (Reduced MaybeReducedArgs Term)
    forall a b. (a -> b) -> a -> b
    $ MaybeReducedArgs -> Reduced MaybeReducedArgs Term
    forall no yes. no -> Reduced no yes
    NoReduction (MaybeReducedArgs -> Reduced MaybeReducedArgs Term)
    -> MaybeReducedArgs -> Reduced MaybeReducedArgs Term
    forall a b. (a -> b) -> a -> b
    $ (Arg Term -> MaybeReduced (Arg Term))
    -> [Arg Term] -> MaybeReducedArgs
    forall a b. (a -> b) -> [a] -> [b]
    map Arg Term -> MaybeReduced (Arg Term)
    forall a. a -> MaybeReduced a
    notReduced [Arg Term
    a,Arg Term
    bA] MaybeReducedArgs -> MaybeReducedArgs -> MaybeReducedArgs
    forall a. [a] -> [a] -> [a]
    ++ [Blocked (Arg Term) -> MaybeReduced (Arg Term)
    reduced Blocked (Arg Term)
    sphi, Arg Term -> MaybeReduced (Arg Term)
    forall a. a -> MaybeReduced a
    notReduced Arg Term
    u, Blocked (Arg Term) -> MaybeReduced (Arg Term)
    reduced Blocked (Arg Term)
    sx]
          [Arg Term]
    _ -> ReduceM (Reduced MaybeReducedArgs Term)
    forall a. HasCallStack => a
    __IMPOSSIBLE__

    primTrans' :: TCM PrimitiveImpl
    primTrans' :: TCM PrimitiveImpl
    primTrans' = do
      Cubical -> TCM ()
    requireCubical Cubical
    CErased
      t    <- Names -> NamesT (TCMT IO) Type -> TCMT IO Type
    forall (m :: * -> *) a. Names -> NamesT m a -> m a
    runNamesT [] (NamesT (TCMT IO) Type -> TCMT IO Type)
    -> NamesT (TCMT IO) Type -> TCMT IO Type
    forall a b. (a -> b) -> a -> b
    $
              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
    hPi' String
    "a" (NamesT (TCMT IO) Type
    forall (m :: * -> *).
    (HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
    m Type
    primIntervalType 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) Sort
    -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
    forall (m :: * -> *). Applicative m => m Sort -> m Term -> m Type
    els (Sort -> NamesT (TCMT IO) Sort
    forall a. a -> NamesT (TCMT IO) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Sort
    forall t. Sort' t
    LevelUniv) (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
    primLevel)) ((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
    a ->
              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
    "A" (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 -> 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
    i -> (Sort -> Type
    sort (Sort -> Type) -> (Term -> Sort) -> Term -> Type
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Term -> Sort
    tmSort (Term -> Type) -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (NamesT (TCMT IO) Term
    a 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) 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
    bA ->
              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
    "φ" NamesT (TCMT IO) Type
    forall (m :: * -> *).
    (HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
    m Type
    primIntervalType ((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
    phi ->
              (NamesT (TCMT IO) Term
    -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Type
    el' (NamesT (TCMT IO) Term
    a NamesT (TCMT IO) Term
    -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <@> 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
    primIZero) (NamesT (TCMT IO) Term
    bA NamesT (TCMT IO) Term
    -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <@> 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
    primIZero) 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) Term
    -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Type
    el' (NamesT (TCMT IO) Term
    a NamesT (TCMT IO) Term
    -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <@> 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
    primIOne) (NamesT (TCMT IO) Term
    bA NamesT (TCMT IO) Term
    -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <@> 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
    primIOne))
      return $ PrimImpl t $ PrimFun __IMPOSSIBLE__ 4 [] $ \[Arg Term]
    ts Nat
    nelims -> do
        Command
    -> [Arg Term] -> Nat -> ReduceM (Reduced MaybeReducedArgs Term)
    primTransHComp Command
    DoTransp [Arg Term]
    ts Nat
    nelims

    primHComp' :: TCM PrimitiveImpl
    primHComp' :: TCM PrimitiveImpl
    primHComp' = do
      Cubical -> TCM ()
    requireCubical Cubical
    CErased
      t    <- Names -> NamesT (TCMT IO) Type -> TCMT IO Type
    forall (m :: * -> *) a. Names -> NamesT m a -> m a
    runNamesT [] (NamesT (TCMT IO) Type -> TCMT IO Type)
    -> NamesT (TCMT IO) Type -> TCMT IO Type
    forall a b. (a -> b) -> a -> b
    $
              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
    hPi' String
    "a" (NamesT (TCMT IO) Sort
    -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
    forall (m :: * -> *). Applicative m => m Sort -> m Term -> m Type
    els (Sort -> NamesT (TCMT IO) Sort
    forall a. a -> NamesT (TCMT IO) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Sort
    forall t. Sort' t
    LevelUniv) (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
    primLevel)) ((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
    a ->
              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
    hPi' String
    "A" (Sort -> Type
    sort (Sort -> Type) -> (Term -> Sort) -> Term -> Type
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Term -> Sort
    tmSort (Term -> Type) -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> NamesT (TCMT IO) Term
    a) ((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
    bA ->
              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
    hPi' String
    "φ" NamesT (TCMT IO) Type
    forall (m :: * -> *).
    (HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
    m Type
    primIntervalType ((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
    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) Term
    -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Type
    el' NamesT (TCMT IO) Term
    a NamesT (TCMT IO) Term
    bA) 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) Term
    -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Type
    el' NamesT (TCMT IO) Term
    a NamesT (TCMT IO) Term
    bA 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) Term
    -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Type
    el' NamesT (TCMT IO) Term
    a NamesT (TCMT IO) Term
    bA)
      let occs = [Occurrence
    Mixed, Occurrence
    StrictPos, Occurrence
    Mixed, Occurrence
    StrictPos, Occurrence
    StrictPos]
      return $ PrimImpl t $ PrimFun __IMPOSSIBLE__ 5 occs $ \[Arg Term]
    ts Nat
    nelims -> do
        Command
    -> [Arg Term] -> Nat -> ReduceM (Reduced MaybeReducedArgs Term)
    primTransHComp Command
    DoHComp [Arg Term]
    ts Nat
    nelims

    -- | Construct a helper for CCHM composition, with a string indicating
    -- what function uses it.
    mkComp :: forall m. HasBuiltins m
           => String
           -> NamesT m (NamesT m Term -> NamesT m Term -> NamesT m Term -> NamesT m Term -> NamesT m Term -> NamesT m Term)
    mkComp :: forall (m :: * -> *).
    HasBuiltins m =>
    String
    -> NamesT
         m
         (NamesT m Term
          -> NamesT m Term
          -> NamesT m Term
          -> NamesT m Term
          -> NamesT m Term
          -> NamesT m Term)
    mkComp String
    s = do
      let getTermLocal :: IsBuiltin a => a -> NamesT m Term
          getTermLocal :: forall a. IsBuiltin a => a -> NamesT m Term
    getTermLocal = String -> a -> NamesT m Term
    forall (m :: * -> *) a.
    (HasBuiltins m, IsBuiltin a) =>
    String -> a -> m Term
    getTerm String
    s
      tIMax  <- PrimitiveId -> NamesT m Term
    forall a. IsBuiltin a => a -> NamesT m Term
    getTermLocal PrimitiveId
    builtinIMax
      tINeg  <- getTermLocal builtinINeg
      tHComp <- getTermLocal builtinHComp
      tTrans <- getTermLocal builtinTrans
      iz     <- getTermLocal builtinIZero
      io     <- getTermLocal builtinIOne

      let
        forward NamesT m Term
    la NamesT m Term
    bA NamesT m Term
    r NamesT m Term
    u = Term -> NamesT m Term
    forall a. a -> NamesT m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Term
    tTrans
          NamesT m Term -> NamesT m Term -> NamesT m Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <#> String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
    forall (m :: * -> *).
    Monad m =>
    String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
    lam String
    "i" (\NamesT m Term
    i -> NamesT m Term
    la NamesT m Term -> NamesT m Term -> NamesT m Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <@> (NamesT m Term
    i NamesT m Term -> NamesT m Term -> NamesT m Term
    forall (m :: * -> *). HasBuiltins m => m Term -> m Term -> m Term
    `imax` NamesT m Term
    r))
          NamesT m Term -> NamesT m Term -> NamesT m Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <@> String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
    forall (m :: * -> *).
    Monad m =>
    String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
    lam String
    "i" (\NamesT m Term
    i -> NamesT m Term
    bA 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 :: * -> *). HasBuiltins m => m Term -> m Term -> m Term
    `imax` NamesT m Term
    r))
          NamesT m Term -> NamesT m Term -> NamesT m Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <@> NamesT m Term
    r
          NamesT m Term -> NamesT m Term -> NamesT m Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <@> NamesT m Term
    u

      pure $ \NamesT m Term
    la NamesT m Term
    bA NamesT m Term
    phi NamesT m Term
    u NamesT m Term
    u0 ->
        Term -> NamesT m Term
    forall a. a -> NamesT m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Term
    tHComp NamesT m Term -> NamesT m Term -> NamesT m Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <#> (NamesT m Term
    la NamesT m Term -> NamesT m Term -> NamesT m Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <@> Term -> NamesT m Term
    forall a. a -> NamesT m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Term
    io) NamesT m Term -> NamesT m Term -> NamesT m Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <#> (NamesT m Term
    bA NamesT m Term -> NamesT m Term -> NamesT m Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <@> Term -> NamesT m Term
    forall a. a -> NamesT m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Term
    io) NamesT m Term -> NamesT m Term -> NamesT m Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <#> NamesT m Term
    phi
                    NamesT m Term -> NamesT m Term -> NamesT m Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <@> String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
    forall (m :: * -> *).
    Monad m =>
    String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
    lam String
    "i" (\NamesT m Term
    i -> String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
    forall (m :: * -> *).
    Monad m =>
    String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
    ilam String
    "o" ((NamesT m Term -> NamesT m Term) -> NamesT m Term)
    -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
    forall a b. (a -> b) -> a -> b
    $ \NamesT m Term
    o ->
                            NamesT m Term
    -> NamesT m Term -> NamesT m Term -> NamesT m Term -> NamesT m Term
    forward NamesT m Term
    la NamesT m Term
    bA NamesT m Term
    i (NamesT m Term
    u 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
    o))
                    NamesT m Term -> NamesT m Term -> NamesT m Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <@> NamesT m Term
    -> NamesT m Term -> NamesT m Term -> NamesT m Term -> NamesT m Term
    forward NamesT m Term
    la NamesT m Term
    bA (Term -> NamesT m Term
    forall a. a -> NamesT m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Term
    iz) NamesT m Term
    u0

    -- | Construct an application of buitlinComp. Use instead of 'mkComp' if
    -- reducing directly to hcomp + transport would be problematic.
    mkCompLazy
      :: HasBuiltins m
      => String
      -> NamesT m (NamesT m Term -> NamesT m Term -> NamesT m Term -> NamesT m Term -> NamesT m Term -> NamesT m Term)
    mkCompLazy :: forall (m :: * -> *).
    HasBuiltins m =>
    String
    -> NamesT
         m
         (NamesT m Term
          -> NamesT m Term
          -> NamesT m Term
          -> NamesT m Term
          -> NamesT m Term
          -> NamesT m Term)
    mkCompLazy String
    s = do
      let getTermLocal :: PrimitiveId -> NamesT m Term
    getTermLocal = String -> PrimitiveId -> NamesT m Term
    forall (m :: * -> *) a.
    (HasBuiltins m, IsBuiltin a) =>
    String -> a -> m Term
    getTerm String
    s
      tComp <- PrimitiveId -> NamesT m Term
    getTermLocal PrimitiveId
    builtinComp
      pure $ \NamesT m Term
    la NamesT m Term
    bA NamesT m Term
    phi NamesT m Term
    u NamesT m Term
    u0 -> Term -> NamesT m Term
    forall a. a -> NamesT m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Term
    tComp NamesT m Term -> NamesT m Term -> NamesT m Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <#> NamesT m Term
    la NamesT m Term -> NamesT m Term -> NamesT m Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <#> NamesT m Term
    bA NamesT m Term -> NamesT m Term -> NamesT m Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <#> NamesT m Term
    phi NamesT m Term -> NamesT m Term -> NamesT m Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <@> NamesT m Term
    u NamesT m Term -> NamesT m Term -> NamesT m Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <@> NamesT m Term
    u0

    -- | Implementation of Kan operations for Pi types. The implementation
    -- of @transp@ and @hcomp@ for Pi types has many commonalities, so most
    -- of it is shared between the two cases.
    doPiKanOp
      :: KanOperation -- ^ Are we composing or transporting?
      -> ArgName      -- ^ Name of the binder
      -> FamilyOrNot (Dom Type, Abs Type)
      -- ^ The domain and codomain of the Pi type.
      -> ReduceM (Maybe Term)
    doPiKanOp :: KanOperation
    -> String
    -> FamilyOrNot (Dom' Term Type, Abs Type)
    -> ReduceM (Maybe Term)
    doPiKanOp KanOperation
    cmd String
    t FamilyOrNot (Dom' Term Type, Abs Type)
    ab = do
      let getTermLocal :: IsBuiltin a => a -> ReduceM Term
          getTermLocal :: forall a. IsBuiltin a => a -> ReduceM Term
    getTermLocal = String -> a -> ReduceM Term
    forall (m :: * -> *) a.
    (HasBuiltins m, IsBuiltin a) =>
    String -> a -> m Term
    getTerm (String -> a -> ReduceM Term) -> String -> a -> ReduceM Term
    forall a b. (a -> b) -> a -> b
    $ KanOperation -> String
    kanOpName KanOperation
    cmd String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " for function types"
      tTrans <- PrimitiveId -> ReduceM Term
    forall a. IsBuiltin a => a -> ReduceM Term
    getTermLocal PrimitiveId
    builtinTrans
      tHComp <- getTermLocal builtinHComp
      tINeg <- getTermLocal builtinINeg
      tIMax <- getTermLocal builtinIMax
      iz    <- getTermLocal builtinIZero

      -- We must guarantee that the codomain is a fibrant type, i.e. one
      -- that supports hcomp and transp. Otherwise, what are we even doing!
      let
        toLevel' a
    t = do
          s <- Sort -> m Sort
    forall a (m :: * -> *). (Reduce a, MonadReduce m) => a -> m a
    reduce (Sort -> m Sort) -> Sort -> m Sort
    forall a b. (a -> b) -> a -> b
    $ a -> Sort
    forall a. LensSort a => a -> Sort
    getSort a
    t
          case s of
            Type Level' Term
    l -> Maybe (Level' Term) -> m (Maybe (Level' Term))
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Level' Term -> Maybe (Level' Term)
    forall a. a -> Maybe a
    Just Level' Term
    l)
            Sort
    _      -> Maybe (Level' Term) -> m (Maybe (Level' Term))
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe (Level' Term)
    forall a. Maybe a
    Nothing
        -- But this case is actually impossible:
        toLevel a
    t = Level' Term -> Maybe (Level' Term) -> Level' Term
    forall a. a -> Maybe a -> a
    fromMaybe Level' Term
    forall a. HasCallStack => a
    __IMPOSSIBLE__ (Maybe (Level' Term) -> Level' Term)
    -> f (Maybe (Level' Term)) -> f (Level' Term)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> a -> f (Maybe (Level' Term))
    forall {m :: * -> *} {a}.
    (MonadReduce m, LensSort a) =>
    a -> m (Maybe (Level' Term))
    toLevel' a
    t

      caseMaybeM (toLevel' . absBody . snd . famThing $ ab) (return Nothing) $ \ Level' Term
    _ -> do
      Names -> NamesT ReduceM (Maybe Term) -> ReduceM (Maybe Term)
    forall (m :: * -> *) a. Names -> NamesT m a -> m a
    runNamesT [] (NamesT ReduceM (Maybe Term) -> ReduceM (Maybe Term))
    -> NamesT ReduceM (Maybe Term) -> ReduceM (Maybe Term)
    forall a b. (a -> b) -> a -> b
    $ do

        -- When doing transport in Pi types, we need to distinguish a couple
        -- of different cases depending on the sort of the domain, since
        -- there are a couple of different possibilities for how we end up
        -- with a fibrant Pi type:
        trFibrantDomain <- do
          let
            (Dom' Term Type
    x, Term -> Term
    f) = case FamilyOrNot (Dom' Term Type, Abs Type)
    ab of
              IsFam (Dom' Term Type
    a, Abs Type
    _) -> (Dom' Term Type
    a, \ Term
    a -> 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
    $ 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
    -> NamesT Identity Term -> NamesT Identity Term
    forall a b. a -> b -> a
    const (Term -> NamesT Identity Term
    forall a. a -> NamesT Identity a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Term
    a)))
              IsNot (Dom' Term Type
    a, Abs Type
    _) -> (Dom' Term Type
    a, Term -> Term
    forall a. a -> a
    id)
          s <- Sort -> NamesT ReduceM Sort
    forall a (m :: * -> *). (Reduce a, MonadReduce m) => a -> m a
    reduce (Sort -> NamesT ReduceM Sort) -> Sort -> NamesT ReduceM Sort
    forall a b. (a -> b) -> a -> b
    $ Dom' Term Type -> Sort
    forall a. LensSort a => a -> Sort
    getSort Dom' Term Type
    x
          case s of
            -- We're looking at a fibrant Pi with fibrant domain: Transport
            -- backwards along the domain.
            Type Level' Term
    lx -> do
              la <- Term -> NamesT ReduceM (NamesT ReduceM Term)
    forall (m :: * -> *) a.
    (Monad m, Subst a) =>
    a -> NamesT m (NamesT m a)
    open (Term -> NamesT ReduceM (NamesT ReduceM Term))
    -> (Term -> Term) -> Term -> NamesT ReduceM (NamesT ReduceM Term)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Term -> Term
    f (Term -> NamesT ReduceM (NamesT ReduceM Term))
    -> Term -> NamesT ReduceM (NamesT ReduceM Term)
    forall a b. (a -> b) -> a -> b
    $ Level' Term -> Term
    Level Level' Term
    lx
              bA <- open . f . unEl . unDom $ x
              pure $ Just $ \NamesT ReduceM Term -> NamesT ReduceM Term
    iOrNot NamesT ReduceM Term
    phi NamesT ReduceM Term
    a0 ->
                Term -> NamesT ReduceM Term
    forall a. a -> NamesT ReduceM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Term
    tTrans NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <#> String
    -> (NamesT ReduceM Term -> NamesT ReduceM Term)
    -> NamesT ReduceM Term
    forall (m :: * -> *).
    Monad m =>
    String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
    lam String
    "j" (\NamesT ReduceM Term
    j -> NamesT ReduceM Term
    la NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <@> NamesT ReduceM Term -> NamesT ReduceM Term
    iOrNot NamesT ReduceM Term
    j)
                  NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <@> String
    -> (NamesT ReduceM Term -> NamesT ReduceM Term)
    -> NamesT ReduceM Term
    forall (m :: * -> *).
    Monad m =>
    String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
    lam String
    "j" (\ NamesT ReduceM Term
    j -> NamesT ReduceM Term
    bA NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <@> NamesT ReduceM Term -> NamesT ReduceM Term
    iOrNot NamesT ReduceM Term
    j)
                  NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <@> NamesT ReduceM Term
    phi
                  NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <@> NamesT ReduceM Term
    a0

            -- We're looking a fibrant Pi whose domain is a lock: No need to do anything.
            Sort
    LockUniv -> Maybe
      ((NamesT ReduceM Term -> NamesT ReduceM Term)
       -> NamesT ReduceM Term
       -> NamesT ReduceM Term
       -> NamesT ReduceM Term)
    -> NamesT
         ReduceM
         (Maybe
            ((NamesT ReduceM Term -> NamesT ReduceM Term)
             -> NamesT ReduceM Term
             -> NamesT ReduceM Term
             -> NamesT ReduceM Term))
    forall a. a -> NamesT ReduceM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe
       ((NamesT ReduceM Term -> NamesT ReduceM Term)
        -> NamesT ReduceM Term
        -> NamesT ReduceM Term
        -> NamesT ReduceM Term)
     -> NamesT
          ReduceM
          (Maybe
             ((NamesT ReduceM Term -> NamesT ReduceM Term)
              -> NamesT ReduceM Term
              -> NamesT ReduceM Term
              -> NamesT ReduceM Term)))
    -> Maybe
         ((NamesT ReduceM Term -> NamesT ReduceM Term)
          -> NamesT ReduceM Term
          -> NamesT ReduceM Term
          -> NamesT ReduceM Term)
    -> NamesT
         ReduceM
         (Maybe
            ((NamesT ReduceM Term -> NamesT ReduceM Term)
             -> NamesT ReduceM Term
             -> NamesT ReduceM Term
             -> NamesT ReduceM Term))
    forall a b. (a -> b) -> a -> b
    $ ((NamesT ReduceM Term -> NamesT ReduceM Term)
     -> NamesT ReduceM Term
     -> NamesT ReduceM Term
     -> NamesT ReduceM Term)
    -> Maybe
         ((NamesT ReduceM Term -> NamesT ReduceM Term)
          -> NamesT ReduceM Term
          -> NamesT ReduceM Term
          -> NamesT ReduceM Term)
    forall a. a -> Maybe a
    Just (((NamesT ReduceM Term -> NamesT ReduceM Term)
      -> NamesT ReduceM Term
      -> NamesT ReduceM Term
      -> NamesT ReduceM Term)
     -> Maybe
          ((NamesT ReduceM Term -> NamesT ReduceM Term)
           -> NamesT ReduceM Term
           -> NamesT ReduceM Term
           -> NamesT ReduceM Term))
    -> ((NamesT ReduceM Term -> NamesT ReduceM Term)
        -> NamesT ReduceM Term
        -> NamesT ReduceM Term
        -> NamesT ReduceM Term)
    -> Maybe
         ((NamesT ReduceM Term -> NamesT ReduceM Term)
          -> NamesT ReduceM Term
          -> NamesT ReduceM Term
          -> NamesT ReduceM Term)
    forall a b. (a -> b) -> a -> b
    $ \NamesT ReduceM Term -> NamesT ReduceM Term
    _ NamesT ReduceM Term
    _ NamesT ReduceM Term
    a0 -> NamesT ReduceM Term
    a0

            -- We're looking at an unmarked path type. Make sure that the
            -- domain is actually the interval before continuing without an
            -- adjustment, though!
            Sort
    IntervalUniv -> do
              x' <- Type -> NamesT ReduceM (Blocked Type)
    forall a (m :: * -> *).
    (Reduce a, MonadReduce m) =>
    a -> m (Blocked a)
    reduceB (Type -> NamesT ReduceM (Blocked Type))
    -> Type -> NamesT ReduceM (Blocked Type)
    forall a b. (a -> b) -> a -> b
    $ Dom' Term Type -> Type
    forall t e. Dom' t e -> e
    unDom Dom' Term Type
    x
              mInterval <- getBuiltinName' builtinInterval
              case unEl $ ignoreBlocking x' of
                Def QName
    q [] | QName -> Maybe QName
    forall a. a -> Maybe a
    Just QName
    q Maybe QName -> Maybe QName -> Bool
    forall a. Eq a => a -> a -> Bool
    == Maybe QName
    mInterval -> Maybe
      ((NamesT ReduceM Term -> NamesT ReduceM Term)
       -> NamesT ReduceM Term
       -> NamesT ReduceM Term
       -> NamesT ReduceM Term)
    -> NamesT
         ReduceM
         (Maybe
            ((NamesT ReduceM Term -> NamesT ReduceM Term)
             -> NamesT ReduceM Term
             -> NamesT ReduceM Term
             -> NamesT ReduceM Term))
    forall a. a -> NamesT ReduceM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe
       ((NamesT ReduceM Term -> NamesT ReduceM Term)
        -> NamesT ReduceM Term
        -> NamesT ReduceM Term
        -> NamesT ReduceM Term)
     -> NamesT
          ReduceM
          (Maybe
             ((NamesT ReduceM Term -> NamesT ReduceM Term)
              -> NamesT ReduceM Term
              -> NamesT ReduceM Term
              -> NamesT ReduceM Term)))
    -> Maybe
         ((NamesT ReduceM Term -> NamesT ReduceM Term)
          -> NamesT ReduceM Term
          -> NamesT ReduceM Term
          -> NamesT ReduceM Term)
    -> NamesT
         ReduceM
         (Maybe
            ((NamesT ReduceM Term -> NamesT ReduceM Term)
             -> NamesT ReduceM Term
             -> NamesT ReduceM Term
             -> NamesT ReduceM Term))
    forall a b. (a -> b) -> a -> b
    $ ((NamesT ReduceM Term -> NamesT ReduceM Term)
     -> NamesT ReduceM Term
     -> NamesT ReduceM Term
     -> NamesT ReduceM Term)
    -> Maybe
         ((NamesT ReduceM Term -> NamesT ReduceM Term)
          -> NamesT ReduceM Term
          -> NamesT ReduceM Term
          -> NamesT ReduceM Term)
    forall a. a -> Maybe a
    Just (((NamesT ReduceM Term -> NamesT ReduceM Term)
      -> NamesT ReduceM Term
      -> NamesT ReduceM Term
      -> NamesT ReduceM Term)
     -> Maybe
          ((NamesT ReduceM Term -> NamesT ReduceM Term)
           -> NamesT ReduceM Term
           -> NamesT ReduceM Term
           -> NamesT ReduceM Term))
    -> ((NamesT ReduceM Term -> NamesT ReduceM Term)
        -> NamesT ReduceM Term
        -> NamesT ReduceM Term
        -> NamesT ReduceM Term)
    -> Maybe
         ((NamesT ReduceM Term -> NamesT ReduceM Term)
          -> NamesT ReduceM Term
          -> NamesT ReduceM Term
          -> NamesT ReduceM Term)
    forall a b. (a -> b) -> a -> b
    $ \NamesT ReduceM Term -> NamesT ReduceM Term
    _ NamesT ReduceM Term
    _ NamesT ReduceM Term
    a0 -> NamesT ReduceM Term
    a0
                Term
    _ -> Maybe
      ((NamesT ReduceM Term -> NamesT ReduceM Term)
       -> NamesT ReduceM Term
       -> NamesT ReduceM Term
       -> NamesT ReduceM Term)
    -> NamesT
         ReduceM
         (Maybe
            ((NamesT ReduceM Term -> NamesT ReduceM Term)
             -> NamesT ReduceM Term
             -> NamesT ReduceM Term
             -> NamesT ReduceM Term))
    forall a. a -> NamesT ReduceM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe
      ((NamesT ReduceM Term -> NamesT ReduceM Term)
       -> NamesT ReduceM Term
       -> NamesT ReduceM Term
       -> NamesT ReduceM Term)
    forall a. Maybe a
    Nothing

            Prop Level' Term
    _     -> Maybe
      ((NamesT ReduceM Term -> NamesT ReduceM Term)
       -> NamesT ReduceM Term
       -> NamesT ReduceM Term
       -> NamesT ReduceM Term)
    -> NamesT
         ReduceM
         (Maybe
            ((NamesT ReduceM Term -> NamesT ReduceM Term)
             -> NamesT ReduceM Term
             -> NamesT ReduceM Term
             -> NamesT ReduceM Term))
    forall a. a -> NamesT ReduceM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe
      ((NamesT ReduceM Term -> NamesT ReduceM Term)
       -> NamesT ReduceM Term
       -> NamesT ReduceM Term
       -> NamesT ReduceM Term)
    forall a. Maybe a
    Nothing
            SSet Level' Term
    _     -> Maybe
      ((NamesT ReduceM Term -> NamesT ReduceM Term)
       -> NamesT ReduceM Term
       -> NamesT ReduceM Term
       -> NamesT ReduceM Term)
    -> NamesT
         ReduceM
         (Maybe
            ((NamesT ReduceM Term -> NamesT ReduceM Term)
             -> NamesT ReduceM Term
             -> NamesT ReduceM Term
             -> NamesT ReduceM Term))
    forall a. a -> NamesT ReduceM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe
      ((NamesT ReduceM Term -> NamesT ReduceM Term)
       -> NamesT ReduceM Term
       -> NamesT ReduceM Term
       -> NamesT ReduceM Term)
    forall a. Maybe a
    Nothing
            Inf Univ
    _ Integer
    _    -> Maybe
      ((NamesT ReduceM Term -> NamesT ReduceM Term)
       -> NamesT ReduceM Term
       -> NamesT ReduceM Term
       -> NamesT ReduceM Term)
    -> NamesT
         ReduceM
         (Maybe
            ((NamesT ReduceM Term -> NamesT ReduceM Term)
             -> NamesT ReduceM Term
             -> NamesT ReduceM Term
             -> NamesT ReduceM Term))
    forall a. a -> NamesT ReduceM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe
      ((NamesT ReduceM Term -> NamesT ReduceM Term)
       -> NamesT ReduceM Term
       -> NamesT ReduceM Term
       -> NamesT ReduceM Term)
    forall a. Maybe a
    Nothing
            Sort
    LevelUniv  -> Maybe
      ((NamesT ReduceM Term -> NamesT ReduceM Term)
       -> NamesT ReduceM Term
       -> NamesT ReduceM Term
       -> NamesT ReduceM Term)
    -> NamesT
         ReduceM
         (Maybe
            ((NamesT ReduceM Term -> NamesT ReduceM Term)
             -> NamesT ReduceM Term
             -> NamesT ReduceM Term
             -> NamesT ReduceM Term))
    forall a. a -> NamesT ReduceM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe
      ((NamesT ReduceM Term -> NamesT ReduceM Term)
       -> NamesT ReduceM Term
       -> NamesT ReduceM Term
       -> NamesT ReduceM Term)
    forall a. Maybe a
    Nothing
            Sort
    SizeUniv   -> Maybe
      ((NamesT ReduceM Term -> NamesT ReduceM Term)
       -> NamesT ReduceM Term
       -> NamesT ReduceM Term
       -> NamesT ReduceM Term)
    -> NamesT
         ReduceM
         (Maybe
            ((NamesT ReduceM Term -> NamesT ReduceM Term)
             -> NamesT ReduceM Term
             -> NamesT ReduceM Term
             -> NamesT ReduceM Term))
    forall a. a -> NamesT ReduceM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe
      ((NamesT ReduceM Term -> NamesT ReduceM Term)
       -> NamesT ReduceM Term
       -> NamesT ReduceM Term
       -> NamesT ReduceM Term)
    forall a. Maybe a
    Nothing
            PiSort{}   -> Maybe
      ((NamesT ReduceM Term -> NamesT ReduceM Term)
       -> NamesT ReduceM Term
       -> NamesT ReduceM Term
       -> NamesT ReduceM Term)
    -> NamesT
         ReduceM
         (Maybe
            ((NamesT ReduceM Term -> NamesT ReduceM Term)
             -> NamesT ReduceM Term
             -> NamesT ReduceM Term
             -> NamesT ReduceM Term))
    forall a. a -> NamesT ReduceM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe
      ((NamesT ReduceM Term -> NamesT ReduceM Term)
       -> NamesT ReduceM Term
       -> NamesT ReduceM Term
       -> NamesT ReduceM Term)
    forall a. Maybe a
    Nothing
            FunSort{}  -> Maybe
      ((NamesT ReduceM Term -> NamesT ReduceM Term)
       -> NamesT ReduceM Term
       -> NamesT ReduceM Term
       -> NamesT ReduceM Term)
    -> NamesT
         ReduceM
         (Maybe
            ((NamesT ReduceM Term -> NamesT ReduceM Term)
             -> NamesT ReduceM Term
             -> NamesT ReduceM Term
             -> NamesT ReduceM Term))
    forall a. a -> NamesT ReduceM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe
      ((NamesT ReduceM Term -> NamesT ReduceM Term)
       -> NamesT ReduceM Term
       -> NamesT ReduceM Term
       -> NamesT ReduceM Term)
    forall a. Maybe a
    Nothing
            UnivSort{} -> Maybe
      ((NamesT ReduceM Term -> NamesT ReduceM Term)
       -> NamesT ReduceM Term
       -> NamesT ReduceM Term
       -> NamesT ReduceM Term)
    -> NamesT
         ReduceM
         (Maybe
            ((NamesT ReduceM Term -> NamesT ReduceM Term)
             -> NamesT ReduceM Term
             -> NamesT ReduceM Term
             -> NamesT ReduceM Term))
    forall a. a -> NamesT ReduceM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe
      ((NamesT ReduceM Term -> NamesT ReduceM Term)
       -> NamesT ReduceM Term
       -> NamesT ReduceM Term
       -> NamesT ReduceM Term)
    forall a. Maybe a
    Nothing
            MetaS{}    -> Maybe
      ((NamesT ReduceM Term -> NamesT ReduceM Term)
       -> NamesT ReduceM Term
       -> NamesT ReduceM Term
       -> NamesT ReduceM Term)
    -> NamesT
         ReduceM
         (Maybe
            ((NamesT ReduceM Term -> NamesT ReduceM Term)
             -> NamesT ReduceM Term
             -> NamesT ReduceM Term
             -> NamesT ReduceM Term))
    forall a. a -> NamesT ReduceM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe
      ((NamesT ReduceM Term -> NamesT ReduceM Term)
       -> NamesT ReduceM Term
       -> NamesT ReduceM Term
       -> NamesT ReduceM Term)
    forall a. Maybe a
    Nothing
            DefS{}     -> Maybe
      ((NamesT ReduceM Term -> NamesT ReduceM Term)
       -> NamesT ReduceM Term
       -> NamesT ReduceM Term
       -> NamesT ReduceM Term)
    -> NamesT
         ReduceM
         (Maybe
            ((NamesT ReduceM Term -> NamesT ReduceM Term)
             -> NamesT ReduceM Term
             -> NamesT ReduceM Term
             -> NamesT ReduceM Term))
    forall a. a -> NamesT ReduceM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe
      ((NamesT ReduceM Term -> NamesT ReduceM Term)
       -> NamesT ReduceM Term
       -> NamesT ReduceM Term
       -> NamesT ReduceM Term)
    forall a. Maybe a
    Nothing
            DummyS{}   -> Maybe
      ((NamesT ReduceM Term -> NamesT ReduceM Term)
       -> NamesT ReduceM Term
       -> NamesT ReduceM Term
       -> NamesT ReduceM Term)
    -> NamesT
         ReduceM
         (Maybe
            ((NamesT ReduceM Term -> NamesT ReduceM Term)
             -> NamesT ReduceM Term
             -> NamesT ReduceM Term
             -> NamesT ReduceM Term))
    forall a. a -> NamesT ReduceM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe
      ((NamesT ReduceM Term -> NamesT ReduceM Term)
       -> NamesT ReduceM Term
       -> NamesT ReduceM Term
       -> NamesT ReduceM Term)
    forall a. Maybe a
    Nothing

        caseMaybe trFibrantDomain (return Nothing) $ \(NamesT ReduceM Term -> NamesT ReduceM Term)
    -> NamesT ReduceM Term
    -> NamesT ReduceM Term
    -> NamesT ReduceM Term
    trA -> Term -> Maybe Term
    forall a. a -> Maybe a
    Just (Term -> Maybe Term)
    -> NamesT ReduceM Term -> NamesT ReduceM (Maybe Term)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> do
        phi <- Term -> NamesT ReduceM (NamesT ReduceM Term)
    forall (m :: * -> *) a.
    (Monad m, Subst a) =>
    a -> NamesT m (NamesT m a)
    open (Term -> NamesT ReduceM (NamesT ReduceM Term))
    -> (Arg Term -> Term)
    -> Arg Term
    -> NamesT ReduceM (NamesT ReduceM Term)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Arg Term -> Term
    forall e. Arg e -> e
    unArg (Arg Term -> NamesT ReduceM (NamesT ReduceM Term))
    -> Arg Term -> NamesT ReduceM (NamesT ReduceM Term)
    forall a b. (a -> b) -> a -> b
    $ Blocked (Arg Term) -> Arg Term
    forall t a. Blocked' t a -> a
    ignoreBlocking (Blocked (Arg Term) -> Arg Term) -> Blocked (Arg Term) -> Arg Term
    forall a b. (a -> b) -> a -> b
    $ KanOperation -> Blocked (Arg Term)
    kanOpCofib KanOperation
    cmd
        u0  <- open . unArg $ kanOpBase cmd

        glam (getArgInfo (fst $ famThing ab)) (absName $ snd $ famThing ab) $ \NamesT ReduceM Term
    u1 -> do
          case (KanOperation
    cmd, FamilyOrNot (Dom' Term Type, Abs Type)
    ab) of

            -- hcomp u u0 x = hcomp (λ i o → u i o x) (u0 x). Short and sweet :)
            (HCompOp Blocked (Arg Term)
    _ Arg Term
    u Arg Term
    _, IsNot (Dom' Term Type
    a , Abs Type
    b)) -> do
              bT <- (Nat -> Abs Type -> Abs Type
    forall a. Subst a => Nat -> a -> a
    raise Nat
    1 Abs Type
    b Abs Type -> SubstArg Type -> Type
    forall a. Subst a => Abs a -> SubstArg a -> a
    `absApp`) (Term -> Type) -> NamesT ReduceM Term -> NamesT ReduceM Type
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> NamesT ReduceM Term
    u1
              u <- open (raise 1 (unArg u))
              pure tHComp
                <#> (Level <$> toLevel bT)
                <#> pure (unEl bT)
                <#> phi
                <@> lam "i" (\ NamesT ReduceM Term
    i -> String
    -> (NamesT ReduceM Term -> NamesT ReduceM Term)
    -> NamesT ReduceM Term
    forall (m :: * -> *).
    Monad m =>
    String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
    ilam String
    "o" ((NamesT ReduceM Term -> NamesT ReduceM Term)
     -> NamesT ReduceM Term)
    -> (NamesT ReduceM Term -> NamesT ReduceM Term)
    -> NamesT ReduceM Term
    forall a b. (a -> b) -> a -> b
    $ \ NamesT ReduceM Term
    o -> Hiding
    -> NamesT ReduceM Term
    -> NamesT ReduceM Term
    -> NamesT ReduceM Term
    forall (m :: * -> *).
    Applicative m =>
    Hiding -> m Term -> m Term -> m Term
    gApply (Dom' Term Type -> Hiding
    forall a. LensHiding a => a -> Hiding
    getHiding Dom' Term Type
    a) (NamesT ReduceM Term
    u NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <@> NamesT ReduceM Term
    i NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <..> NamesT ReduceM Term
    o) NamesT ReduceM Term
    u1)
                <@> gApply (getHiding a) u0 u1

            -- transp (λ i → (a : A i) → B i x) φ f u1 =
            --  transp (λ i → B i (transp (λ j → A (i ∨ ~ j)) (φ ∨ i) x)) φ
            --    (f (transp (λ j → A (~ j) φ x)))
            (TranspOp Blocked (Arg Term)
    _ Arg Term
    _, IsFam (Dom' Term Type
    a , Abs Type
    b)) -> do
              -- trA is a function of three arguments which builds the
              -- transport fillers in the opposite direction, hence its
              -- first argument is called "iOrNot" where it's relevant.
              let
                -- Γ , u1 : A[i1] , i : I
                v :: NamesT ReduceM Term -> NamesT ReduceM Term
    v NamesT ReduceM Term
    i = (NamesT ReduceM Term -> NamesT ReduceM Term)
    -> NamesT ReduceM Term
    -> NamesT ReduceM Term
    -> NamesT ReduceM Term
    trA (NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
    forall (m :: * -> *). HasBuiltins m => m Term -> m Term -> m Term
    imax NamesT ReduceM Term
    i (NamesT ReduceM Term -> NamesT ReduceM Term)
    -> (NamesT ReduceM Term -> NamesT ReduceM Term)
    -> NamesT ReduceM Term
    -> NamesT ReduceM Term
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . NamesT ReduceM Term -> NamesT ReduceM Term
    forall (m :: * -> *). HasBuiltins m => m Term -> m Term
    ineg) (NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
    forall (m :: * -> *). HasBuiltins m => m Term -> m Term -> m Term
    imax NamesT ReduceM Term
    phi NamesT ReduceM Term
    i) NamesT ReduceM Term
    u1
                bB :: Term -> Type
    bB Term
    v = Term -> Substitution' Term -> Substitution' Term
    forall a. DeBruijn a => a -> Substitution' a -> Substitution' a
    consS Term
    v (Nat -> Substitution' Term -> Substitution' Term
    forall a. Nat -> Substitution' a -> Substitution' a
    liftS Nat
    1 (Substitution' Term -> Substitution' Term)
    -> Substitution' Term -> Substitution' Term
    forall a b. (a -> b) -> a -> b
    $ Nat -> Substitution' Term
    forall a. Nat -> Substitution' a
    raiseS Nat
    1) Substitution' (SubstArg Type) -> Type -> Type
    forall a. Subst a => Substitution' (SubstArg a) -> a -> a
    `applySubst`
                  (Abs Type -> Type
    forall a. Subst a => Abs a -> a
    absBody Abs Type
    b {- Γ , i : I , x : A[i] -})

                -- Compute B @0 v, in the right scope
                tLam :: Abs Term -> Term
    tLam = ArgInfo -> Abs Term -> Term
    Lam ArgInfo
    defaultArgInfo

              -- We know how to substitute v into B, but it's open in a
              -- variable, so we close over it here:
              bT <- String
    -> ((forall b. (Subst b, DeBruijn b) => NamesT ReduceM b)
        -> NamesT ReduceM Type)
    -> NamesT ReduceM (Abs 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 ReduceM b)
      -> NamesT ReduceM Type)
     -> NamesT ReduceM (Abs Type))
    -> ((forall b. (Subst b, DeBruijn b) => NamesT ReduceM b)
        -> NamesT ReduceM Type)
    -> NamesT ReduceM (Abs Type)
    forall a b. (a -> b) -> a -> b
    $ \ forall b. (Subst b, DeBruijn b) => NamesT ReduceM b
    x -> (Term -> Type) -> NamesT ReduceM Term -> NamesT ReduceM Type
    forall a b. (a -> b) -> NamesT ReduceM a -> NamesT ReduceM b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Term -> Type
    bB (NamesT ReduceM Term -> NamesT ReduceM Type)
    -> (NamesT ReduceM Term -> NamesT ReduceM Term)
    -> NamesT ReduceM Term
    -> NamesT ReduceM Type
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . NamesT ReduceM Term -> NamesT ReduceM Term
    v (NamesT ReduceM Term -> NamesT ReduceM Type)
    -> NamesT ReduceM Term -> NamesT ReduceM Type
    forall a b. (a -> b) -> a -> b
    $ NamesT ReduceM Term
    forall b. (Subst b, DeBruijn b) => NamesT ReduceM b
    x

              pure tTrans
                <#> (tLam <$> traverse (fmap Level . toLevel) bT)
                <@> (pure . tLam $ unEl <$> bT)
                <@> phi
                <@> gApply (getHiding a) u0 (v (pure iz))

            (KanOperation
    _, FamilyOrNot (Dom' Term Type, Abs Type)
    _) -> String -> NamesT ReduceM Term
    forall (m :: * -> *) a.
    (HasCallStack, MonadDebug m) =>
    String -> m a
    __IMPOSSIBLE_VERBOSE__ String
    "Invalid Kan operation in doPiKanOp"

    -- | Compute Kan operations in a type of dependent paths.
    doPathPKanOp
      :: KanOperation
      -> FamilyOrNot (Arg Term)
      -> FamilyOrNot (Arg Term, Arg Term, Arg Term)
      -> ReduceM (Reduced MaybeReducedArgs Term)
    doPathPKanOp :: KanOperation
    -> FamilyOrNot (Arg Term)
    -> FamilyOrNot (Arg Term, Arg Term, Arg Term)
    -> ReduceM (Reduced MaybeReducedArgs Term)
    doPathPKanOp (HCompOp Blocked (Arg Term)
    phi Arg Term
    u Arg Term
    u0) (IsNot Arg Term
    l) (IsNot (Arg Term
    bA,Arg Term
    x,Arg Term
    y)) = do
      let getTermLocal :: PrimitiveId -> ReduceM Term
    getTermLocal = String -> PrimitiveId -> ReduceM Term
    forall (m :: * -> *) a.
    (HasBuiltins m, IsBuiltin a) =>
    String -> a -> m Term
    getTerm String
    "primHComp for path types"
      tHComp <- PrimitiveId -> ReduceM Term
    getTermLocal PrimitiveId
    builtinHComp

      redReturn <=< runNamesT [] $ do
        l   <- open . unArg $ l
        u   <- open . unArg $ u
        u0  <- open . unArg $ u0
        phi <- open . unArg $ ignoreBlocking phi
        bA  <- open . unArg $ bA
        x   <- open . unArg $ x
        y   <- open . unArg $ y

        -- hcomp in path spaces is simply hcomp in the underlying space, but
        -- fixing the endpoints at (j ∨ ~ j) in the new direction to those
        -- in the Path type.
        lam "j" $ \ NamesT ReduceM Term
    j ->
          Term -> NamesT ReduceM Term
    forall a. a -> NamesT ReduceM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Term
    tHComp NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <#> NamesT ReduceM Term
    l NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <#> (NamesT ReduceM Term
    bA NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <@> NamesT ReduceM Term
    j) NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <#> (NamesT ReduceM Term
    phi NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
    forall (m :: * -> *). HasBuiltins m => m Term -> m Term -> m Term
    `imax` (NamesT ReduceM Term -> NamesT ReduceM Term
    forall (m :: * -> *). HasBuiltins m => m Term -> m Term
    ineg NamesT ReduceM Term
    j NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
    forall (m :: * -> *). HasBuiltins m => m Term -> m Term -> m Term
    `imax` NamesT ReduceM Term
    j))
            NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <@> String
    -> (NamesT ReduceM Term -> NamesT ReduceM Term)
    -> NamesT ReduceM Term
    forall (m :: * -> *).
    Monad m =>
    String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
    lam String
    "i'" (\NamesT ReduceM Term
    i -> NamesT ReduceM Term
    -> NamesT ReduceM Term
    -> [(NamesT ReduceM Term, NamesT ReduceM Term)]
    -> NamesT ReduceM Term
    forall (m :: * -> *).
    HasBuiltins m =>
    NamesT m Term
    -> NamesT m Term
    -> [(NamesT m Term, NamesT m Term)]
    -> NamesT m Term
    combineSys NamesT ReduceM Term
    l (NamesT ReduceM Term
    bA NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <@> NamesT ReduceM Term
    i)
              [ (NamesT ReduceM Term
    phi,    String
    -> (NamesT ReduceM Term -> NamesT ReduceM Term)
    -> NamesT ReduceM Term
    forall (m :: * -> *).
    Monad m =>
    String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
    ilam String
    "o" (\ NamesT ReduceM Term
    o -> NamesT ReduceM Term
    u NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <@> NamesT ReduceM Term
    i NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <..> NamesT ReduceM Term
    o NamesT ReduceM Term
    -> (NamesT ReduceM Term, NamesT ReduceM Term, NamesT ReduceM Term)
    -> NamesT ReduceM Term
    forall (m :: * -> *).
    Applicative m =>
    m Term -> (m Term, m Term, m Term) -> m Term
    <@@> (NamesT ReduceM Term
    x, NamesT ReduceM Term
    y, NamesT ReduceM Term
    j)))
              , (NamesT ReduceM Term
    j,      String
    -> (NamesT ReduceM Term -> NamesT ReduceM Term)
    -> NamesT ReduceM Term
    forall (m :: * -> *).
    Monad m =>
    String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
    ilam String
    "o" (NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
    forall a b. a -> b -> a
    const NamesT ReduceM Term
    y))
              , (NamesT ReduceM Term -> NamesT ReduceM Term
    forall (m :: * -> *). HasBuiltins m => m Term -> m Term
    ineg NamesT ReduceM Term
    j, String
    -> (NamesT ReduceM Term -> NamesT ReduceM Term)
    -> NamesT ReduceM Term
    forall (m :: * -> *).
    Monad m =>
    String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
    ilam String
    "o" (NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
    forall a b. a -> b -> a
    const NamesT ReduceM Term
    x)) ])
            NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <@> (NamesT ReduceM Term
    u0 NamesT ReduceM Term
    -> (NamesT ReduceM Term, NamesT ReduceM Term, NamesT ReduceM Term)
    -> NamesT ReduceM Term
    forall (m :: * -> *).
    Applicative m =>
    m Term -> (m Term, m Term, m Term) -> m Term
    <@@> (NamesT ReduceM Term
    x, NamesT ReduceM Term
    y, NamesT ReduceM Term
    j))

    doPathPKanOp (TranspOp Blocked (Arg Term)
    phi Arg Term
    u0) (IsFam Arg Term
    l) (IsFam (Arg Term
    bA,Arg Term
    x,Arg Term
    y)) = do
      let getTermLocal :: BuiltinId -> ReduceM Term
    getTermLocal = String -> BuiltinId -> ReduceM Term
    forall (m :: * -> *) a.
    (HasBuiltins m, IsBuiltin a) =>
    String -> a -> m Term
    getTerm String
    "transport for path types"
      iz <- BuiltinId -> ReduceM Term
    getTermLocal BuiltinId
    builtinIZero
      io <- getTermLocal builtinIOne

      -- Transport in path types becomes /CCHM/ composition in the
      -- underlying line of spaces. The intuition is that not only do we
      -- have to fix the endpoints (using composition) but also actually
      -- transport. CCHM composition conveniently does that for us!
      --
      -- Γ ⊢ l : I → Level
      --     l is already a function "coming in"
      -- Γ, i ⊢ bA   : Type (l i)
      -- Γ, i ⊢ x, y : bA
      -- Γ ⊢ u0 : PathP (A/i0) (x/i0) (y/i0)
      -- Γ, φ ⊢ bA constant
      --
      --   transp {l} (λ i → PathP A x y) φ p = λ j →
      --      comp {λ i → l j} (λ i → A i j) (φ ∨ j ∨ ~ j) λ i where
      --        (φ = i1 ∨ i = i0) → p j
      --        (j = i0)          → x i
      --        (j = i1)          → y i
      --   : PathP A/i1 x/i1 y/i1

      redReturn <=< runNamesT [] $ do
        -- In reality to avoid a round-trip between primComp we use mkComp
        -- here.
        comp <- mkComp $ "transport for path types"
        l   <- open . unArg $ l
        u0  <- open . unArg $ u0
        phi <- open . unArg $ ignoreBlocking phi
        let lami = Term -> NamesT ReduceM (NamesT ReduceM Term)
    forall (m :: * -> *) a.
    (Monad m, Subst a) =>
    a -> NamesT m (NamesT m a)
    open (Term -> NamesT ReduceM (NamesT ReduceM Term))
    -> (Arg Term -> Term)
    -> Arg Term
    -> NamesT ReduceM (NamesT ReduceM Term)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Names -> NamesT Identity Term -> Term
    forall a. Names -> NamesT Identity a -> a
    runNames [] (NamesT Identity Term -> Term)
    -> (Arg Term -> NamesT Identity Term) -> Arg Term -> Term
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . 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 -> NamesT Identity Term)
     -> NamesT Identity Term)
    -> (Arg Term -> NamesT Identity Term -> NamesT Identity Term)
    -> Arg Term
    -> NamesT Identity Term
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . NamesT Identity Term
    -> NamesT Identity Term -> NamesT Identity Term
    forall a b. a -> b -> a
    const (NamesT Identity Term
     -> NamesT Identity Term -> NamesT Identity Term)
    -> (Arg Term -> NamesT Identity Term)
    -> Arg Term
    -> NamesT Identity Term
    -> NamesT Identity Term
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Term -> NamesT Identity Term
    forall a. a -> NamesT Identity a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Term -> NamesT Identity Term)
    -> (Arg Term -> Term) -> Arg Term -> NamesT Identity Term
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Arg Term -> Term
    forall e. Arg e -> e
    unArg
        bA  <- lami bA
        x   <- lami x
        y   <- lami y
        -- Γ ⊢ bA : (i : I) → Type (l i)
        -- Γ ⊢ x, y : (i : I) → bA i

        lam "j" $ \ NamesT ReduceM Term
    j ->
          NamesT ReduceM Term
    -> NamesT ReduceM Term
    -> NamesT ReduceM Term
    -> NamesT ReduceM Term
    -> NamesT ReduceM Term
    -> NamesT ReduceM Term
    comp NamesT ReduceM Term
    l (String
    -> (NamesT ReduceM Term -> NamesT ReduceM Term)
    -> NamesT ReduceM Term
    forall (m :: * -> *).
    Monad m =>
    String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
    lam String
    "i" ((NamesT ReduceM Term -> NamesT ReduceM Term)
     -> NamesT ReduceM Term)
    -> (NamesT ReduceM Term -> NamesT ReduceM Term)
    -> NamesT ReduceM Term
    forall a b. (a -> b) -> a -> b
    $ \ NamesT ReduceM Term
    i -> NamesT ReduceM Term
    bA NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <@> NamesT ReduceM Term
    i NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <@> NamesT ReduceM Term
    j) (NamesT ReduceM Term
    phi NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
    forall (m :: * -> *). HasBuiltins m => m Term -> m Term -> m Term
    `imax` (NamesT ReduceM Term -> NamesT ReduceM Term
    forall (m :: * -> *). HasBuiltins m => m Term -> m Term
    ineg NamesT ReduceM Term
    j NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
    forall (m :: * -> *). HasBuiltins m => m Term -> m Term -> m Term
    `imax` NamesT ReduceM Term
    j))
            (String
    -> (NamesT ReduceM Term -> NamesT ReduceM Term)
    -> NamesT ReduceM Term
    forall (m :: * -> *).
    Monad m =>
    String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
    lam String
    "i'" ((NamesT ReduceM Term -> NamesT ReduceM Term)
     -> NamesT ReduceM Term)
    -> (NamesT ReduceM Term -> NamesT ReduceM Term)
    -> NamesT ReduceM Term
    forall a b. (a -> b) -> a -> b
    $ \NamesT ReduceM Term
    i -> NamesT ReduceM Term
    -> NamesT ReduceM Term
    -> [(NamesT ReduceM Term, NamesT ReduceM Term)]
    -> NamesT ReduceM Term
    forall (m :: * -> *).
    HasBuiltins m =>
    NamesT m Term
    -> NamesT m Term
    -> [(NamesT m Term, NamesT m Term)]
    -> NamesT m Term
    combineSys (NamesT ReduceM Term
    l NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <@> NamesT ReduceM Term
    i) (NamesT ReduceM Term
    bA NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <@> NamesT ReduceM Term
    i NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <@> NamesT ReduceM Term
    j)
              [ (NamesT ReduceM Term
    phi, String
    -> (NamesT ReduceM Term -> NamesT ReduceM Term)
    -> NamesT ReduceM Term
    forall (m :: * -> *).
    Monad m =>
    String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
    ilam String
    "o" (\NamesT ReduceM Term
    o -> NamesT ReduceM Term
    u0 NamesT ReduceM Term
    -> (NamesT ReduceM Term, NamesT ReduceM Term, NamesT ReduceM Term)
    -> NamesT ReduceM Term
    forall (m :: * -> *).
    Applicative m =>
    m Term -> (m Term, m Term, m Term) -> m Term
    <@@> (NamesT ReduceM Term
    x NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <@> Term -> NamesT ReduceM Term
    forall a. a -> NamesT ReduceM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Term
    iz, NamesT ReduceM Term
    y NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <@> Term -> NamesT ReduceM Term
    forall a. a -> NamesT ReduceM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Term
    iz, NamesT ReduceM Term
    j)))
              -- Note that here we have lines of endpoints, which we must
              -- apply to fix the endpoints:
              , (NamesT ReduceM Term
    j,      String
    -> (NamesT ReduceM Term -> NamesT ReduceM Term)
    -> NamesT ReduceM Term
    forall (m :: * -> *).
    Monad m =>
    String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
    ilam String
    "_" (NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
    forall a b. a -> b -> a
    const (NamesT ReduceM Term
    y NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <@> NamesT ReduceM Term
    i)))
              , (NamesT ReduceM Term -> NamesT ReduceM Term
    forall (m :: * -> *). HasBuiltins m => m Term -> m Term
    ineg NamesT ReduceM Term
    j, String
    -> (NamesT ReduceM Term -> NamesT ReduceM Term)
    -> NamesT ReduceM Term
    forall (m :: * -> *).
    Monad m =>
    String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
    ilam String
    "_" (NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
    forall a b. a -> b -> a
    const (NamesT ReduceM Term
    x NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <@> NamesT ReduceM Term
    i)))
              ])
            (NamesT ReduceM Term
    u0 NamesT ReduceM Term
    -> (NamesT ReduceM Term, NamesT ReduceM Term, NamesT ReduceM Term)
    -> NamesT ReduceM Term
    forall (m :: * -> *).
    Applicative m =>
    m Term -> (m Term, m Term, m Term) -> m Term
    <@@> (NamesT ReduceM Term
    x NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <@> Term -> NamesT ReduceM Term
    forall a. a -> NamesT ReduceM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Term
    iz, NamesT ReduceM Term
    y NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <@> Term -> NamesT ReduceM Term
    forall a. a -> NamesT ReduceM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Term
    iz, NamesT ReduceM Term
    j))
    doPathPKanOp KanOperation
    a0 FamilyOrNot (Arg Term)
    _ FamilyOrNot (Arg Term, Arg Term, Arg Term)
    _ = ReduceM (Reduced MaybeReducedArgs Term)
    forall a. HasCallStack => a
    __IMPOSSIBLE__

    redReturnNoSimpl :: a -> ReduceM (Reduced a' a)
    redReturnNoSimpl :: forall a a'. a -> ReduceM (Reduced a' a)
    redReturnNoSimpl = Reduced a' a -> ReduceM (Reduced a' a)
    forall a. a -> ReduceM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Reduced a' a -> ReduceM (Reduced a' a))
    -> (a -> Reduced a' a) -> a -> ReduceM (Reduced a' a)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Simplification -> a -> Reduced a' a
    forall no yes. Simplification -> yes -> Reduced no yes
    YesReduction Simplification
    NoSimplification

    primTransHComp :: Command -> [Arg Term] -> Int -> ReduceM (Reduced MaybeReducedArgs Term)
    primTransHComp :: Command
    -> [Arg Term] -> Nat -> ReduceM (Reduced MaybeReducedArgs Term)
    primTransHComp Command
    cmd [Arg Term]
    ts Nat
    nelims = do
      (l,bA,phi,u,u0) <- (FamilyOrNot (Arg Term), FamilyOrNot (Arg Term), Arg Term,
     Maybe (Arg Term), Arg Term)
    -> ReduceM
         (FamilyOrNot (Arg Term), FamilyOrNot (Arg Term), Arg Term,
          Maybe (Arg Term), Arg Term)
    forall a. a -> ReduceM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ((FamilyOrNot (Arg Term), FamilyOrNot (Arg Term), Arg Term,
      Maybe (Arg Term), Arg Term)
     -> ReduceM
          (FamilyOrNot (Arg Term), FamilyOrNot (Arg Term), Arg Term,
           Maybe (Arg Term), Arg Term))
    -> (FamilyOrNot (Arg Term), FamilyOrNot (Arg Term), Arg Term,
        Maybe (Arg Term), Arg Term)
    -> ReduceM
         (FamilyOrNot (Arg Term), FamilyOrNot (Arg Term), Arg Term,
          Maybe (Arg Term), Arg Term)
    forall a b. (a -> b) -> a -> b
    $ case (Command
    cmd,[Arg Term]
    ts) of
        (Command
    DoTransp, [Arg Term
    l, Arg Term
    bA, Arg Term
    phi, Arg Term
    u0]) -> (Arg Term -> FamilyOrNot (Arg Term)
    forall a. a -> FamilyOrNot a
    IsFam Arg Term
    l, Arg Term -> FamilyOrNot (Arg Term)
    forall a. a -> FamilyOrNot a
    IsFam Arg Term
    bA, Arg Term
    phi, Maybe (Arg Term)
    forall a. Maybe a
    Nothing, Arg Term
    u0)
        (Command
    DoHComp, [Arg Term
    l, Arg Term
    bA, Arg Term
    phi, Arg Term
    u, Arg Term
    u0]) -> (Arg Term -> FamilyOrNot (Arg Term)
    forall a. a -> FamilyOrNot a
    IsNot Arg Term
    l, Arg Term -> FamilyOrNot (Arg Term)
    forall a. a -> FamilyOrNot a
    IsNot Arg Term
    bA, Arg Term
    phi, Arg Term -> Maybe (Arg Term)
    forall a. a -> Maybe a
    Just Arg Term
    u, Arg Term
    u0)
        (Command, [Arg Term])
    _ -> (FamilyOrNot (Arg Term), FamilyOrNot (Arg Term), Arg Term,
     Maybe (Arg Term), Arg Term)
    forall a. HasCallStack => a
    __IMPOSSIBLE__
      sphi <- reduceB' phi
      vphi <- intervalView $ unArg $ ignoreBlocking sphi
      let clP a
    s = String -> a -> m Term
    forall (m :: * -> *) a.
    (HasBuiltins m, IsBuiltin a) =>
    String -> a -> m Term
    getTerm String
    "primTransHComp" a
    s

      -- WORK
      case vphi of
        -- When φ = i1, we know what to do! These cases are counted as
        -- simplifications.
        IntervalView
    IOne -> Term -> ReduceM (Reduced MaybeReducedArgs Term)
    forall a a'. a -> ReduceM (Reduced a' a)
    redReturn (Term -> ReduceM (Reduced MaybeReducedArgs Term))
    -> ReduceM Term -> ReduceM (Reduced MaybeReducedArgs Term)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< case Command
    cmd of
          Command
    DoHComp -> Names -> NamesT ReduceM Term -> ReduceM Term
    forall (m :: * -> *) a. Names -> NamesT m a -> m a
    runNamesT [] (NamesT ReduceM Term -> ReduceM Term)
    -> NamesT ReduceM Term -> ReduceM Term
    forall a b. (a -> b) -> a -> b
    $ do
            -- If we're composing, then we definitely had a partial element
            -- to extend. But now it's just a total element, so we can
            -- just.. return it:
            u <- Term -> NamesT ReduceM (NamesT ReduceM Term)
    forall (m :: * -> *) a.
    (Monad m, Subst a) =>
    a -> NamesT m (NamesT m a)
    open (Term -> NamesT ReduceM (NamesT ReduceM Term))
    -> Term -> NamesT ReduceM (NamesT ReduceM Term)
    forall a b. (a -> b) -> a -> b
    $ Arg Term -> Term
    forall e. Arg e -> e
    unArg (Arg Term -> Term) -> Arg Term -> Term
    forall a b. (a -> b) -> a -> b
    $ Arg Term -> Maybe (Arg Term) -> Arg Term
    forall a. a -> Maybe a -> a
    fromMaybe Arg Term
    forall a. HasCallStack => a
    __IMPOSSIBLE__ Maybe (Arg Term)
    u
            u <@> clP builtinIOne <..> clP builtinItIsOne
          Command
    DoTransp ->
            -- Otherwise we're in the constant part of the line to transport
            -- over, so we must return the argument unchanged.
            Term -> ReduceM Term
    forall a. a -> ReduceM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Term -> ReduceM Term) -> Term -> ReduceM Term
    forall a b. (a -> b) -> a -> b
    $ Arg Term -> Term
    forall e. Arg e -> e
    unArg Arg Term
    u0

        IntervalView
    _ -> do
        let
          fallback' :: Blocked (Arg Term) -> ReduceM (Reduced MaybeReducedArgs Term)
    fallback' Blocked (Arg Term)
    sc = do
            -- Possibly optimise the partial element to reduce the size of
            -- hcomps:
            u' <- case Command
    cmd of
              Command
    DoHComp -> (MaybeReduced (Arg Term) -> MaybeReducedArgs -> MaybeReducedArgs
    forall a. a -> [a] -> [a]
    :[]) (MaybeReduced (Arg Term) -> MaybeReducedArgs)
    -> ReduceM (MaybeReduced (Arg Term)) -> ReduceM MaybeReducedArgs
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> case IntervalView
    vphi of
                -- If φ=i0 then tabulating equality for Partial φ A
                -- guarantees that u = is constantly isOneEmpty,
                -- regardless of how big the original term is, and
                -- isOneEmpty is *tiny*, so let's use that:
                IntervalView
    IZero -> (Term -> MaybeReduced (Arg Term))
    -> ReduceM Term -> ReduceM (MaybeReduced (Arg Term))
    forall a b. (a -> b) -> ReduceM a -> ReduceM b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (Blocked (Arg Term) -> MaybeReduced (Arg Term)
    reduced (Blocked (Arg Term) -> MaybeReduced (Arg Term))
    -> (Term -> Blocked (Arg Term)) -> Term -> MaybeReduced (Arg Term)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Arg Term -> Blocked (Arg Term)
    forall a t. a -> Blocked' t a
    notBlocked (Arg Term -> Blocked (Arg Term))
    -> (Term -> Arg Term) -> Term -> Blocked (Arg Term)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Term -> Arg Term
    forall e. e -> Arg e
    argN) (ReduceM Term -> ReduceM (MaybeReduced (Arg Term)))
    -> (NamesT ReduceM Term -> ReduceM Term)
    -> NamesT ReduceM Term
    -> ReduceM (MaybeReduced (Arg Term))
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Names -> NamesT ReduceM Term -> ReduceM Term
    forall (m :: * -> *) a. Names -> NamesT m a -> m a
    runNamesT [] (NamesT ReduceM Term -> ReduceM (MaybeReduced (Arg Term)))
    -> NamesT ReduceM Term -> ReduceM (MaybeReduced (Arg Term))
    forall a b. (a -> b) -> a -> b
    $ do
                    l <- Term -> NamesT ReduceM (NamesT ReduceM Term)
    forall (m :: * -> *) a.
    (Monad m, Subst a) =>
    a -> NamesT m (NamesT m a)
    open (Term -> NamesT ReduceM (NamesT ReduceM Term))
    -> (FamilyOrNot (Arg Term) -> Term)
    -> FamilyOrNot (Arg Term)
    -> NamesT ReduceM (NamesT ReduceM Term)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Arg Term -> Term
    forall e. Arg e -> e
    unArg (Arg Term -> Term)
    -> (FamilyOrNot (Arg Term) -> Arg Term)
    -> FamilyOrNot (Arg Term)
    -> Term
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . FamilyOrNot (Arg Term) -> Arg Term
    forall a. FamilyOrNot a -> a
    famThing (FamilyOrNot (Arg Term) -> NamesT ReduceM (NamesT ReduceM Term))
    -> FamilyOrNot (Arg Term) -> NamesT ReduceM (NamesT ReduceM Term)
    forall a b. (a -> b) -> a -> b
    $ FamilyOrNot (Arg Term)
    l
                    c <- open . unArg . ignoreBlocking $ sc
                    lam "i" $ \ NamesT ReduceM Term
    i -> BuiltinId -> NamesT ReduceM Term
    forall {m :: * -> *} {a}.
    (HasBuiltins m, IsBuiltin a) =>
    a -> m Term
    clP BuiltinId
    builtinIsOneEmpty NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <#> NamesT ReduceM Term
    l NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <#> String
    -> (NamesT ReduceM Term -> NamesT ReduceM Term)
    -> NamesT ReduceM Term
    forall (m :: * -> *).
    Monad m =>
    String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
    ilam String
    "o" (\ NamesT ReduceM Term
    _ -> NamesT ReduceM Term
    c)

                -- Otherwise we have some interesting formula (though
                -- definitely not IOne!) and we have to keep the partial
                -- element as-is.
                IntervalView
    _ -> MaybeReduced (Arg Term) -> ReduceM (MaybeReduced (Arg Term))
    forall a. a -> ReduceM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (MaybeReduced (Arg Term) -> ReduceM (MaybeReduced (Arg Term)))
    -> MaybeReduced (Arg Term) -> ReduceM (MaybeReduced (Arg Term))
    forall a b. (a -> b) -> a -> b
    $ Arg Term -> MaybeReduced (Arg Term)
    forall a. a -> MaybeReduced a
    notReduced (Arg Term -> MaybeReduced (Arg Term))
    -> Arg Term -> MaybeReduced (Arg Term)
    forall a b. (a -> b) -> a -> b
    $ Arg Term -> Maybe (Arg Term) -> Arg Term
    forall a. a -> Maybe a -> a
    fromMaybe Arg Term
    forall a. HasCallStack => a
    __IMPOSSIBLE__ Maybe (Arg Term)
    u
              Command
    DoTransp -> MaybeReducedArgs -> ReduceM MaybeReducedArgs
    forall a. a -> ReduceM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return []

            pure . NoReduction $ [notReduced (famThing l), reduced sc, reduced sphi] ++ u' ++ [notReduced u0]

        -- Reduce the type whose Kan operations we're composing over:
        sbA <- FamilyOrNot (Arg Term)
    -> ReduceM (Blocked (FamilyOrNot (Arg Term)))
    forall t. Reduce t => t -> ReduceM (Blocked t)
    reduceB' FamilyOrNot (Arg Term)
    bA
        t <- case unArg <$> ignoreBlocking sbA of
          IsFam (Lam ArgInfo
    _ Abs Term
    t) -> Blocked' Term (FamilyOrNot Term)
    -> Maybe (Blocked' Term (FamilyOrNot Term))
    forall a. a -> Maybe a
    Just (Blocked' Term (FamilyOrNot Term)
     -> Maybe (Blocked' Term (FamilyOrNot Term)))
    -> (Blocked' Term Term -> Blocked' Term (FamilyOrNot Term))
    -> Blocked' Term Term
    -> Maybe (Blocked' Term (FamilyOrNot Term))
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Term -> FamilyOrNot Term)
    -> Blocked' Term Term -> Blocked' Term (FamilyOrNot Term)
    forall a b. (a -> b) -> Blocked' Term a -> Blocked' Term b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Term -> FamilyOrNot Term
    forall a. a -> FamilyOrNot a
    IsFam (Blocked' Term Term -> Maybe (Blocked' Term (FamilyOrNot Term)))
    -> ReduceM (Blocked' Term Term)
    -> ReduceM (Maybe (Blocked' Term (FamilyOrNot Term)))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Term -> ReduceM (Blocked' Term Term)
    forall t. Reduce t => t -> ReduceM (Blocked t)
    reduceB' (Abs Term -> Term
    forall a. Subst a => Abs a -> a
    absBody Abs Term
    t)
          IsFam Term
    _         -> Maybe (Blocked' Term (FamilyOrNot Term))
    -> ReduceM (Maybe (Blocked' Term (FamilyOrNot Term)))
    forall a. a -> ReduceM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe (Blocked' Term (FamilyOrNot Term))
    forall a. Maybe a
    Nothing
          IsNot Term
    t         -> Maybe (Blocked' Term (FamilyOrNot Term))
    -> ReduceM (Maybe (Blocked' Term (FamilyOrNot Term)))
    forall a. a -> ReduceM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Maybe (Blocked' Term (FamilyOrNot Term))
     -> ReduceM (Maybe (Blocked' Term (FamilyOrNot Term))))
    -> (Blocked' Term Term -> Maybe (Blocked' Term (FamilyOrNot Term)))
    -> Blocked' Term Term
    -> ReduceM (Maybe (Blocked' Term (FamilyOrNot Term)))
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Blocked' Term (FamilyOrNot Term)
    -> Maybe (Blocked' Term (FamilyOrNot Term))
    forall a. a -> Maybe a
    Just (Blocked' Term (FamilyOrNot Term)
     -> Maybe (Blocked' Term (FamilyOrNot Term)))
    -> (Blocked' Term Term -> Blocked' Term (FamilyOrNot Term))
    -> Blocked' Term Term
    -> Maybe (Blocked' Term (FamilyOrNot Term))
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Term -> FamilyOrNot Term)
    -> Blocked' Term Term -> Blocked' Term (FamilyOrNot Term)
    forall a b. (a -> b) -> Blocked' Term a -> Blocked' Term b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Term -> FamilyOrNot Term
    forall a. a -> FamilyOrNot a
    IsNot (Blocked' Term Term
     -> ReduceM (Maybe (Blocked' Term (FamilyOrNot Term))))
    -> Blocked' Term Term
    -> ReduceM (Maybe (Blocked' Term (FamilyOrNot Term)))
    forall a b. (a -> b) -> a -> b
    $ (Term
    t Term -> Blocked (FamilyOrNot (Arg Term)) -> Blocked' Term Term
    forall a b. a -> Blocked' Term b -> Blocked' Term a
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ Blocked (FamilyOrNot (Arg Term))
    sbA)

        case t of
          -- If we don't have a grasp of the Kan operations then at least we
          -- can reuse the work we did for reducing the type later.
          Maybe (Blocked' Term (FamilyOrNot Term))
    Nothing -> Blocked (Arg Term) -> ReduceM (Reduced MaybeReducedArgs Term)
    fallback' (FamilyOrNot (Arg Term) -> Arg Term
    forall a. FamilyOrNot a -> a
    famThing (FamilyOrNot (Arg Term) -> Arg Term)
    -> Blocked (FamilyOrNot (Arg Term)) -> Blocked (Arg Term)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Blocked (FamilyOrNot (Arg Term))
    sbA)
          Just Blocked' Term (FamilyOrNot Term)
    st  -> do
            -- Similarly, if we're stuck for another reason, we can reuse
            -- the work for reducing the family.
            let
              fallback :: ReduceM (Reduced MaybeReducedArgs Term)
    fallback = Blocked (Arg Term) -> ReduceM (Reduced MaybeReducedArgs Term)
    fallback' ((FamilyOrNot (Arg Term) -> Arg Term)
    -> Blocked (FamilyOrNot (Arg Term)) -> Blocked (Arg Term)
    forall a b. (a -> b) -> Blocked' Term a -> Blocked' Term b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap FamilyOrNot (Arg Term) -> Arg Term
    forall a. FamilyOrNot a -> a
    famThing (Blocked (FamilyOrNot (Arg Term)) -> Blocked (Arg Term))
    -> Blocked (FamilyOrNot (Arg Term)) -> Blocked (Arg Term)
    forall a b. (a -> b) -> a -> b
    $ Blocked' Term (FamilyOrNot Term)
    st Blocked' Term (FamilyOrNot Term)
    -> Blocked (FamilyOrNot (Arg Term))
    -> Blocked (FamilyOrNot (Arg Term))
    forall a b. Blocked' Term a -> Blocked' Term b -> Blocked' Term b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> Blocked (FamilyOrNot (Arg Term))
    sbA)
              t :: FamilyOrNot Term
    t = Blocked' Term (FamilyOrNot Term) -> FamilyOrNot Term
    forall t a. Blocked' t a -> a
    ignoreBlocking Blocked' Term (FamilyOrNot Term)
    st
              operation :: KanOperation
    operation = case Command
    cmd of
                Command
    DoTransp -> TranspOp { kanOpCofib :: Blocked (Arg Term)
    kanOpCofib = Blocked (Arg Term)
    sphi, kanOpBase :: Arg Term
    kanOpBase = Arg Term
    u0 }
                Command
    DoHComp -> HCompOp
                  { kanOpCofib :: Blocked (Arg Term)
    kanOpCofib = Blocked (Arg Term)
    sphi, kanOpSides :: Arg Term
    kanOpSides = Arg Term -> Maybe (Arg Term) -> Arg Term
    forall a. a -> Maybe a -> a
    fromMaybe Arg Term
    forall a. HasCallStack => a
    __IMPOSSIBLE__ Maybe (Arg Term)
    u, kanOpBase :: Arg Term
    kanOpBase = Arg Term
    u0 }

            mHComp <- PrimitiveId -> ReduceM (Maybe QName)
    forall (m :: * -> *).
    HasBuiltins m =>
    PrimitiveId -> m (Maybe QName)
    getPrimitiveName' PrimitiveId
    builtinHComp
            mGlue <- getPrimitiveName' builtinGlue
            pathV <- pathView'

            -- By cases on the family, determine what Kan operation we defer
            -- to:
            case famThing t of
              -- Metavariables are stuck
              MetaV MetaId
    m [Elim]
    _ -> Blocked (Arg Term) -> ReduceM (Reduced MaybeReducedArgs Term)
    fallback' ((FamilyOrNot (Arg Term) -> Arg Term)
    -> Blocked (FamilyOrNot (Arg Term)) -> Blocked (Arg Term)
    forall a b. (a -> b) -> Blocked' Term a -> Blocked' Term b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap FamilyOrNot (Arg Term) -> Arg Term
    forall a. FamilyOrNot a -> a
    famThing (Blocked (FamilyOrNot (Arg Term)) -> Blocked (Arg Term))
    -> Blocked (FamilyOrNot (Arg Term)) -> Blocked (Arg Term)
    forall a b. (a -> b) -> a -> b
    $ MetaId -> Blocked' Term ()
    forall t. MetaId -> Blocked' t ()
    blocked_ MetaId
    m Blocked' Term ()
    -> Blocked (FamilyOrNot (Arg Term))
    -> Blocked (FamilyOrNot (Arg Term))
    forall a b. Blocked' Term a -> Blocked' Term b -> Blocked' Term b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> Blocked (FamilyOrNot (Arg Term))
    sbA)

              -- TODO: absName t instead of "i"
              Pi Dom' Term Type
    a Abs Type
    b
                -- For Π types, we prefer to keep the Kan operations around,
                -- so only actually reduce if we applied them to a nonzero
                -- positive of eliminations
                | Nat
    nelims Nat -> Nat -> Bool
    forall a. Ord a => a -> a -> Bool
    > Nat
    0 -> ReduceM (Reduced MaybeReducedArgs Term)
    -> (Term -> ReduceM (Reduced MaybeReducedArgs Term))
    -> Maybe Term
    -> ReduceM (Reduced MaybeReducedArgs Term)
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe ReduceM (Reduced MaybeReducedArgs Term)
    fallback Term -> ReduceM (Reduced MaybeReducedArgs Term)
    forall a a'. a -> ReduceM (Reduced a' a)
    redReturn (Maybe Term -> ReduceM (Reduced MaybeReducedArgs Term))
    -> ReduceM (Maybe Term) -> ReduceM (Reduced MaybeReducedArgs Term)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< KanOperation
    -> String
    -> FamilyOrNot (Dom' Term Type, Abs Type)
    -> ReduceM (Maybe Term)
    doPiKanOp KanOperation
    operation String
    "i" ((Dom' Term Type
    a, Abs Type
    b) (Dom' Term Type, Abs Type)
    -> FamilyOrNot Term -> FamilyOrNot (Dom' Term Type, Abs Type)
    forall a b. a -> FamilyOrNot b -> FamilyOrNot a
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ FamilyOrNot Term
    t)
                | Bool
    otherwise -> ReduceM (Reduced MaybeReducedArgs Term)
    fallback

              -- For Type, we have two possibilities:
              Sort (Type Level' Term
    l)
                -- transp (λ i → Type _) φ is always the identity function.
                | Command
    DoTransp <- Command
    cmd -> Term -> ReduceM (Reduced MaybeReducedArgs Term)
    forall a a'. a -> ReduceM (Reduced a' a)
    redReturn (Term -> ReduceM (Reduced MaybeReducedArgs Term))
    -> Term -> ReduceM (Reduced MaybeReducedArgs Term)
    forall a b. (a -> b) -> a -> b
    $ Arg Term -> Term
    forall e. Arg e -> e
    unArg Arg Term
    u0
                -- hcomp {Type} is actually a normal form! This is the
                -- "HCompU" optimisation; We do not use Glue for hcomp in
                -- the universe.
                | Command
    DoHComp <- Command
    cmd -> ReduceM (Reduced MaybeReducedArgs Term)
    fallback

              -- Glue types have their own implementation of Kan operations
              -- which are implemented in a different module:
              Def QName
    q [Apply Arg Term
    la, Apply Arg Term
    lb, Apply Arg Term
    bA, Apply Arg Term
    phi', Apply Arg Term
    bT, Apply Arg Term
    e] | QName -> Maybe QName
    forall a. a -> Maybe a
    Just QName
    q Maybe QName -> Maybe QName -> Bool
    forall a. Eq a => a -> a -> Bool
    == Maybe QName
    mGlue -> do
                ReduceM (Reduced MaybeReducedArgs Term)
    -> (Term -> ReduceM (Reduced MaybeReducedArgs Term))
    -> Maybe Term
    -> ReduceM (Reduced MaybeReducedArgs Term)
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe ReduceM (Reduced MaybeReducedArgs Term)
    fallback Term -> ReduceM (Reduced MaybeReducedArgs Term)
    forall a a'. a -> ReduceM (Reduced a' a)
    redReturn (Maybe Term -> ReduceM (Reduced MaybeReducedArgs Term))
    -> ReduceM (Maybe Term) -> ReduceM (Reduced MaybeReducedArgs Term)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< KanOperation
    -> FamilyOrNot
         (Arg Term, Arg Term, Arg Term, Arg Term, Arg Term, Arg Term)
    -> TermPosition
    -> ReduceM (Maybe Term)
    forall (m :: * -> *).
    PureTCM m =>
    KanOperation
    -> FamilyOrNot
         (Arg Term, Arg Term, Arg Term, Arg Term, Arg Term, Arg Term)
    -> TermPosition
    -> m (Maybe Term)
    doGlueKanOp
                  KanOperation
    operation ((Arg Term
    la, Arg Term
    lb, Arg Term
    bA, Arg Term
    phi', Arg Term
    bT, Arg Term
    e) (Arg Term, Arg Term, Arg Term, Arg Term, Arg Term, Arg Term)
    -> FamilyOrNot Term
    -> FamilyOrNot
         (Arg Term, Arg Term, Arg Term, Arg Term, Arg Term, Arg Term)
    forall a b. a -> FamilyOrNot b -> FamilyOrNot a
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ FamilyOrNot Term
    t) TermPosition
    Head

              -- Formal homogeneous compositions in the universe: Our family
              -- is @hcomp {A = Type l}@, so we defer to the implementation
              -- of Kan operations for HCompU implemented above.
              Def QName
    q [Apply Arg Term
    _, Apply Arg Term
    s, Apply Arg Term
    phi', Apply Arg Term
    bT, Apply Arg Term
    bA]
                | QName -> Maybe QName
    forall a. a -> Maybe a
    Just QName
    q Maybe QName -> Maybe QName -> Bool
    forall a. Eq a => a -> a -> Bool
    == Maybe QName
    mHComp, Sort (Type Level' Term
    la) <- Arg Term -> Term
    forall e. Arg e -> e
    unArg Arg Term
    s  -> do
                ReduceM (Reduced MaybeReducedArgs Term)
    -> (Term -> ReduceM (Reduced MaybeReducedArgs Term))
    -> Maybe Term
    -> ReduceM (Reduced MaybeReducedArgs Term)
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe ReduceM (Reduced MaybeReducedArgs Term)
    fallback Term -> ReduceM (Reduced MaybeReducedArgs Term)
    forall a a'. a -> ReduceM (Reduced a' a)
    redReturn (Maybe Term -> ReduceM (Reduced MaybeReducedArgs Term))
    -> ReduceM (Maybe Term) -> ReduceM (Reduced MaybeReducedArgs Term)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< KanOperation
    -> FamilyOrNot (Arg Term, Arg Term, Arg Term, Arg Term)
    -> TermPosition
    -> ReduceM (Maybe Term)
    forall (m :: * -> *).
    PureTCM m =>
    KanOperation
    -> FamilyOrNot (Arg Term, Arg Term, Arg Term, Arg Term)
    -> TermPosition
    -> m (Maybe Term)
    doHCompUKanOp
                  KanOperation
    operation ((Level' Term -> Term
    Level Level' Term
    la Term -> Arg Term -> Arg Term
    forall a b. a -> Arg b -> Arg a
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ Arg Term
    s, Arg Term
    phi', Arg Term
    bT, Arg Term
    bA) (Arg Term, Arg Term, Arg Term, Arg Term)
    -> FamilyOrNot Term
    -> FamilyOrNot (Arg Term, Arg Term, Arg Term, Arg Term)
    forall a b. a -> FamilyOrNot b -> FamilyOrNot a
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ FamilyOrNot Term
    t) TermPosition
    Head

              -- PathP types have the same optimisation as for Pi types:
              -- Only compute the Kan operation if there's >0 eliminations.
              Term
    d | PathType Sort
    _ QName
    _ Arg Term
    _ Arg Term
    bA Arg Term
    x Arg Term
    y <- Type -> PathView
    pathV (Sort -> Term -> Type
    forall t a. Sort' t -> a -> Type'' t a
    El Sort
    HasCallStack => Sort
    __DUMMY_SORT__ Term
    d) -> do
                if Nat
    nelims Nat -> Nat -> Bool
    forall a. Ord a => a -> a -> Bool
    > Nat
    0 then KanOperation
    -> FamilyOrNot (Arg Term)
    -> FamilyOrNot (Arg Term, Arg Term, Arg Term)
    -> ReduceM (Reduced MaybeReducedArgs Term)
    doPathPKanOp KanOperation
    operation FamilyOrNot (Arg Term)
    l ((Arg Term
    bA, Arg Term
    x, Arg Term
    y) (Arg Term, Arg Term, Arg Term)
    -> FamilyOrNot Term -> FamilyOrNot (Arg Term, Arg Term, Arg Term)
    forall a b. a -> FamilyOrNot b -> FamilyOrNot a
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ FamilyOrNot Term
    t) else ReduceM (Reduced MaybeReducedArgs Term)
    fallback

              Def QName
    q [Elim]
    es -> do
                info <- QName -> ReduceM Definition
    forall (m :: * -> *). HasConstInfo m => QName -> m Definition
    getConstInfo QName
    q
                let
                  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"

                  -- When should Kan operations on a record value reduce?
                  doR r :: Defn
    r@Record{recEtaEquality' :: Defn -> EtaEquality
    recEtaEquality' = EtaEquality
    eta} = case EtaEquality -> HasEta
    theEtaEquality EtaEquality
    eta of
                    -- If it's a no-eta, pattern-matching record, then the
                    -- Kan operations behave as they do for data types; Only
                    -- reduce when the base is a constructor
                    NoEta PatternOrCopattern
    PatternMatching -> case Arg Term -> Term
    forall e. Arg e -> e
    unArg Arg Term
    u0 of
                      Con{} -> Bool
    True
                      Term
    _ -> Bool
    False
                    -- For every other case, we can reduce into a value
                    -- defined by copatterns; However, this would expose the
                    -- internal name of transp/hcomp when printed, so hold
                    -- off until there are projections.
                    HasEta
    _ -> Nat
    nelims Nat -> Nat -> Bool
    forall a. Ord a => a -> a -> Bool
    > Nat
    0
                  doR Defn
    _ = Bool
    False

                -- Record and data types have their own implementations of
                -- the Kan operations, which get generated as part of their
                -- definition.
                case theDef info of
                  r :: Defn
    r@Record{recComp :: Defn -> CompKit
    recComp = CompKit
    kit, recEtaEquality' :: Defn -> EtaEquality
    recEtaEquality' = EtaEquality
    eta}
                    | Defn -> Bool
    doR Defn
    r, Just [Arg Term]
    as <- [Elim] -> Maybe [Arg Term]
    forall a. [Elim' a] -> Maybe [Arg a]
    allApplyElims [Elim]
    es, Command
    DoTransp <- Command
    cmd, Just QName
    transpR <- CompKit -> Maybe QName
    nameOfTransp CompKit
    kit ->
                      -- Optimisation: If the record has no parameters then we can ditch the transport.
                      if Defn -> Nat
    recPars Defn
    r Nat -> Nat -> Bool
    forall a. Eq a => a -> a -> Bool
    == Nat
    0
                         then Term -> ReduceM (Reduced MaybeReducedArgs Term)
    forall a a'. a -> ReduceM (Reduced a' a)
    redReturn (Term -> ReduceM (Reduced MaybeReducedArgs Term))
    -> Term -> ReduceM (Reduced MaybeReducedArgs Term)
    forall a b. (a -> b) -> a -> b
    $ Arg Term -> Term
    forall e. Arg e -> e
    unArg Arg Term
    u0
                         else Term -> ReduceM (Reduced MaybeReducedArgs Term)
    forall a a'. a -> ReduceM (Reduced a' a)
    redReturn (Term -> ReduceM (Reduced MaybeReducedArgs Term))
    -> Term -> ReduceM (Reduced MaybeReducedArgs Term)
    forall a b. (a -> b) -> a -> b
    $ QName -> [Elim] -> Term
    Def QName
    transpR [] Term -> [Arg Term] -> Term
    forall t. Apply t => t -> [Arg Term] -> t
    `apply` ((Arg Term -> Arg Term) -> [Arg Term] -> [Arg Term]
    forall a b. (a -> b) -> [a] -> [b]
    map ((Term -> Term) -> Arg Term -> Arg Term
    forall a b. (a -> b) -> Arg a -> Arg b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Term -> Term
    lam_i) [Arg Term]
    as [Arg Term] -> [Arg Term] -> [Arg Term]
    forall a. [a] -> [a] -> [a]
    ++ [Blocked (Arg Term) -> Arg Term
    forall t a. Blocked' t a -> a
    ignoreBlocking Blocked (Arg Term)
    sphi, Arg Term
    u0])

                    -- Records know how to hcomp themselves:
                    | Defn -> Bool
    doR Defn
    r, Just [Arg Term]
    as <- [Elim] -> Maybe [Arg Term]
    forall a. [Elim' a] -> Maybe [Arg a]
    allApplyElims [Elim]
    es, Command
    DoHComp <- Command
    cmd, Just QName
    hCompR <- CompKit -> Maybe QName
    nameOfHComp CompKit
    kit ->
                      Term -> ReduceM (Reduced MaybeReducedArgs Term)
    forall a a'. a -> ReduceM (Reduced a' a)
    redReturn (Term -> ReduceM (Reduced MaybeReducedArgs Term))
    -> Term -> ReduceM (Reduced MaybeReducedArgs Term)
    forall a b. (a -> b) -> a -> b
    $ QName -> [Elim] -> Term
    Def QName
    hCompR [] Term -> [Arg Term] -> Term
    forall t. Apply t => t -> [Arg Term] -> t
    `apply` ([Arg Term]
    as [Arg Term] -> [Arg Term] -> [Arg Term]
    forall a. [a] -> [a] -> [a]
    ++ [Blocked (Arg Term) -> Arg Term
    forall t a. Blocked' t a -> a
    ignoreBlocking Blocked (Arg Term)
    sphi, Arg Term -> Maybe (Arg Term) -> Arg Term
    forall a. a -> Maybe a -> a
    fromMaybe Arg Term
    forall a. HasCallStack => a
    __IMPOSSIBLE__ Maybe (Arg Term)
    u,Arg Term
    u0])

                    -- If this is a record with no fields, then compData
                    -- will know what to do with it:
                    | Just [Arg Term]
    as <- [Elim] -> Maybe [Arg Term]
    forall a. [Elim' a] -> Maybe [Arg a]
    allApplyElims [Elim]
    es, [] <- Defn -> [Dom QName]
    recFields Defn
    r -> Maybe QName
    -> Bool
    -> Nat
    -> Command
    -> FamilyOrNot (Arg Term)
    -> FamilyOrNot [Arg Term]
    -> Blocked (FamilyOrNot (Arg Term))
    -> Blocked (Arg Term)
    -> Maybe (Arg Term)
    -> Arg Term
    -> ReduceM (Reduced MaybeReducedArgs Term)
    forall {a}.
    (Eq a, Num a, Pretty a) =>
    Maybe QName
    -> Bool
    -> a
    -> Command
    -> FamilyOrNot (Arg Term)
    -> FamilyOrNot [Arg Term]
    -> Blocked (FamilyOrNot (Arg Term))
    -> Blocked (Arg Term)
    -> Maybe (Arg Term)
    -> Arg Term
    -> ReduceM (Reduced MaybeReducedArgs Term)
    compData Maybe QName
    forall a. Maybe a
    Nothing Bool
    False (Defn -> Nat
    recPars Defn
    r) Command
    cmd FamilyOrNot (Arg Term)
    l ([Arg Term]
    as [Arg Term] -> FamilyOrNot Term -> FamilyOrNot [Arg Term]
    forall a b. a -> FamilyOrNot b -> FamilyOrNot a
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ FamilyOrNot Term
    t) Blocked (FamilyOrNot (Arg Term))
    sbA Blocked (Arg Term)
    sphi Maybe (Arg Term)
    u Arg Term
    u0

                  -- For data types, if this data type is indexed and/or a
                  -- higher inductive type, then hcomp is normal; But
                  -- compData knows what to do for the general cases.
                  Datatype{dataPars :: Defn -> Nat
    dataPars = Nat
    pars, dataIxs :: Defn -> Nat
    dataIxs = Nat
    ixs, dataPathCons :: Defn -> [QName]
    dataPathCons = [QName]
    pcons, dataTransp :: Defn -> Maybe QName
    dataTransp = Maybe QName
    mtrD}
                    | [Bool] -> Bool
    forall (t :: * -> *). Foldable t => t Bool -> Bool
    and [[QName] -> Bool
    forall a. Null a => a -> Bool
    null [QName]
    pcons Bool -> Bool -> Bool
    && Nat
    ixs Nat -> Nat -> Bool
    forall a. Eq a => a -> a -> Bool
    == Nat
    0 | Command
    DoHComp  <- [Command
    cmd]], Just [Arg Term]
    as <- [Elim] -> Maybe [Arg Term]
    forall a. [Elim' a] -> Maybe [Arg a]
    allApplyElims [Elim]
    es ->
                      Maybe QName
    -> Bool
    -> Nat
    -> Command
    -> FamilyOrNot (Arg Term)
    -> FamilyOrNot [Arg Term]
    -> Blocked (FamilyOrNot (Arg Term))
    -> Blocked (Arg Term)
    -> Maybe (Arg Term)
    -> Arg Term
    -> ReduceM (Reduced MaybeReducedArgs Term)
    forall {a}.
    (Eq a, Num a, Pretty a) =>
    Maybe QName
    -> Bool
    -> a
    -> Command
    -> FamilyOrNot (Arg Term)
    -> FamilyOrNot [Arg Term]
    -> Blocked (FamilyOrNot (Arg Term))
    -> Blocked (Arg Term)
    -> Maybe (Arg Term)
    -> Arg Term
    -> ReduceM (Reduced MaybeReducedArgs Term)
    compData Maybe QName
    mtrD (Bool -> Bool
    not ([QName] -> Bool
    forall a. Null a => a -> Bool
    null [QName]
    pcons) Bool -> Bool -> Bool
    || Nat
    ixs Nat -> Nat -> Bool
    forall a. Ord a => a -> a -> Bool
    > Nat
    0) (Nat
    pars Nat -> Nat -> Nat
    forall a. Num a => a -> a -> a
    + Nat
    ixs) Command
    cmd FamilyOrNot (Arg Term)
    l ([Arg Term]
    as [Arg Term] -> FamilyOrNot Term -> FamilyOrNot [Arg Term]
    forall a b. a -> FamilyOrNot b -> FamilyOrNot a
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ FamilyOrNot Term
    t) Blocked (FamilyOrNot (Arg Term))
    sbA Blocked (Arg Term)
    sphi Maybe (Arg Term)
    u Arg Term
    u0

                  -- Is this an axiom with constrant transport? Then. Well. Transport is constant.
                  Axiom Bool
    constTransp | Bool
    constTransp, [] <- [Elim]
    es, Command
    DoTransp <- Command
    cmd -> Term -> ReduceM (Reduced MaybeReducedArgs Term)
    forall a a'. a -> ReduceM (Reduced a' a)
    redReturn (Term -> ReduceM (Reduced MaybeReducedArgs Term))
    -> Term -> ReduceM (Reduced MaybeReducedArgs Term)
    forall a b. (a -> b) -> a -> b
    $ Arg Term -> Term
    forall e. Arg e -> e
    unArg Arg Term
    u0

                  Defn
    _          -> ReduceM (Reduced MaybeReducedArgs Term)
    fallback

              Term
    _ -> ReduceM (Reduced MaybeReducedArgs Term)
    fallback
      where
        allComponentsBack :: (IntervalView -> Term)
    -> Term
    -> Term
    -> (Term -> a)
    -> ReduceM ([a], [Maybe (Blocked' Term Term, IntMap Bool)])
    allComponentsBack IntervalView -> Term
    unview Term
    phi Term
    u Term -> a
    p = do
                let
                  boolToI :: Bool -> Term
    boolToI Bool
    b = if Bool
    b then IntervalView -> Term
    unview IntervalView
    IOne else IntervalView -> Term
    unview IntervalView
    IZero
                  lamlam :: Term -> Term
    lamlam Term
    t = ArgInfo -> Abs Term -> Term
    Lam ArgInfo
    defaultArgInfo (String -> Term -> Abs Term
    forall a. String -> a -> Abs a
    Abs String
    "i" (ArgInfo -> Abs Term -> Term
    Lam ArgInfo
    defaultIrrelevantArgInfo (String -> Term -> Abs Term
    forall a. String -> a -> Abs a
    Abs String
    "o" Term
    t)))
                as <- Term -> ReduceM [(IntMap Bool, [Term])]
    forall (m :: * -> *).
    HasBuiltins m =>
    Term -> m [(IntMap Bool, [Term])]
    decomposeInterval Term
    phi
                (flags,t_alphas) <- fmap unzip . forM as $ \ (IntMap Bool
    bs,[Term]
    ts) -> do
                     let u' :: Term
    u' = [(Nat, Term)] -> Substitution' Term
    forall a. EndoSubst a => [(Nat, a)] -> Substitution' a
    listS [(Nat, Term)]
    bs' Substitution' (SubstArg Term) -> Term -> Term
    forall a. Subst a => Substitution' (SubstArg a) -> a -> a
    `applySubst` Term
    u
                         bs' :: [(Nat, Term)]
    bs' = IntMap Term -> [(Nat, Term)]
    forall a. IntMap a -> [(Nat, a)]
    IntMap.toAscList (IntMap Term -> [(Nat, Term)]) -> IntMap Term -> [(Nat, Term)]
    forall a b. (a -> b) -> a -> b
    $ (Bool -> Term) -> IntMap Bool -> IntMap Term
    forall a b. (a -> b) -> IntMap a -> IntMap b
    IntMap.map Bool -> Term
    boolToI IntMap Bool
    bs
                         -- Γ₁, i : I, Γ₂, j : I, Γ₃  ⊢ weaken : Γ₁, Γ₂, Γ₃   for bs' = [(j,_),(i,_)]
                         -- ordering of "j,i,.." matters.
                     let weaken :: Substitution' Term
    weaken = (Nat -> Substitution' Term -> Substitution' Term)
    -> Substitution' Term -> [Nat] -> Substitution' Term
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr (\ Nat
    j Substitution' Term
    s -> Substitution' Term
    s Substitution' Term -> Substitution' Term -> Substitution' Term
    forall a.
    EndoSubst a =>
    Substitution' a -> Substitution' a -> Substitution' a
    `composeS` Nat -> Nat -> Substitution' Term
    forall a. Nat -> Nat -> Substitution' a
    raiseFromS Nat
    j Nat
    1) Substitution' Term
    forall a. Substitution' a
    idS (((Nat, Term) -> Nat) -> [(Nat, Term)] -> [Nat]
    forall a b. (a -> b) -> [a] -> [b]
    map (Nat, Term) -> Nat
    forall a b. (a, b) -> a
    fst [(Nat, Term)]
    bs')
                     t <- Term -> ReduceM (Blocked' Term Term)
    reduce2Lam Term
    u'
                     return $ (p $ ignoreBlocking t, listToMaybe [ (weaken `applySubst` (lamlam <$> t),bs) | null ts ])
                return $ (flags,t_alphas)
        compData :: Maybe QName
    -> Bool
    -> a
    -> Command
    -> FamilyOrNot (Arg Term)
    -> FamilyOrNot [Arg Term]
    -> Blocked (FamilyOrNot (Arg Term))
    -> Blocked (Arg Term)
    -> Maybe (Arg Term)
    -> Arg Term
    -> ReduceM (Reduced MaybeReducedArgs Term)
    compData Maybe QName
    mtrD Bool
    False a
    _ cmd :: Command
    cmd@Command
    DoHComp (IsNot Arg Term
    l) (IsNot [Arg Term]
    ps) Blocked (FamilyOrNot (Arg Term))
    fsc Blocked (Arg Term)
    sphi (Just Arg Term
    u) Arg Term
    a0 = do
          let getTermLocal :: IsBuiltin a => a -> ReduceM Term
              getTermLocal :: forall a. IsBuiltin a => a -> ReduceM Term
    getTermLocal = String -> a -> ReduceM Term
    forall (m :: * -> *) a.
    (HasBuiltins m, IsBuiltin a) =>
    String -> a -> m Term
    getTerm (String -> a -> ReduceM Term) -> String -> a -> ReduceM Term
    forall a b. (a -> b) -> a -> b
    $ String
    "builtinHComp for data types"

          let sc :: Blocked (Arg Term)
    sc = FamilyOrNot (Arg Term) -> Arg Term
    forall a. FamilyOrNot a -> a
    famThing (FamilyOrNot (Arg Term) -> Arg Term)
    -> Blocked (FamilyOrNot (Arg Term)) -> Blocked (Arg Term)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Blocked (FamilyOrNot (Arg Term))
    fsc
          tEmpty <- BuiltinId -> ReduceM Term
    forall a. IsBuiltin a => a -> ReduceM Term
    getTermLocal BuiltinId
    builtinIsOneEmpty
          tPOr   <- getTermLocal builtinPOr
          iO   <- getTermLocal builtinIOne
          iZ   <- getTermLocal builtinIZero
          tMin <- getTermLocal builtinIMin
          tNeg <- getTermLocal builtinINeg
          let iNeg Term
    t = Term
    tNeg Term -> [Arg Term] -> Term
    forall t. Apply t => t -> [Arg Term] -> t
    `apply` [Term -> Arg Term
    forall e. e -> Arg e
    argN Term
    t]
              iMin Term
    t Term
    u = Term
    tMin Term -> [Arg Term] -> Term
    forall t. Apply t => t -> [Arg Term] -> t
    `apply` [Term -> Arg Term
    forall e. e -> Arg e
    argN Term
    t, Term -> Arg Term
    forall e. e -> Arg e
    argN Term
    u]
              iz = Term -> NamesT ReduceM Term
    forall a. a -> NamesT ReduceM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Term
    iZ
          constrForm <- do
            mz <- getTerm' builtinZero
            ms <- getTerm' builtinSuc
            return $ \ Term
    t -> Term -> Maybe Term -> Term
    forall a. a -> Maybe a -> a
    fromMaybe Term
    t (Maybe Term -> Maybe Term -> Term -> Maybe Term
    forall (m :: * -> *).
    Applicative m =>
    m Term -> m Term -> Term -> m Term
    constructorForm' Maybe Term
    mz Maybe Term
    ms Term
    t)
          su  <- reduceB' u
          sa0 <- reduceB' a0
          view   <- intervalView'
          unview <- intervalUnview'
          let f = Arg c -> c
    forall e. Arg e -> e
    unArg (Arg c -> c)
    -> (Blocked' t (Arg c) -> Arg c) -> Blocked' t (Arg c) -> c
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Blocked' t (Arg c) -> Arg c
    forall t a. Blocked' t a -> a
    ignoreBlocking
              phi = Blocked (Arg Term) -> Term
    forall {t} {c}. Blocked' t (Arg c) -> c
    f Blocked (Arg Term)
    sphi
              a0 = Blocked (Arg Term) -> Term
    forall {t} {c}. Blocked' t (Arg c) -> c
    f Blocked (Arg Term)
    sa0
              isLit t :: Term
    t@(Lit Literal
    lt) = Term -> Maybe Term
    forall a. a -> Maybe a
    Just Term
    t
              isLit Term
    _ = Maybe Term
    forall a. Maybe a
    Nothing
              isCon (Con ConHead
    h ConInfo
    _ [Elim]
    _) = ConHead -> Maybe ConHead
    forall a. a -> Maybe a
    Just ConHead
    h
              isCon Term
    _           = Maybe ConHead
    forall a. Maybe a
    Nothing
              combine NamesT ReduceM Term
    l NamesT ReduceM Term
    ty NamesT ReduceM Term
    d [] = NamesT ReduceM Term
    d
              combine NamesT ReduceM Term
    l NamesT ReduceM Term
    ty NamesT ReduceM Term
    d [(NamesT ReduceM Term
    psi,NamesT ReduceM Term
    u)] = NamesT ReduceM Term
    u
              combine NamesT ReduceM Term
    l NamesT ReduceM Term
    ty NamesT ReduceM Term
    d ((NamesT ReduceM Term
    psi,NamesT ReduceM Term
    u):[(NamesT ReduceM Term, NamesT ReduceM Term)]
    xs)
                = Term -> NamesT ReduceM Term
    forall a. a -> NamesT ReduceM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Term
    tPOr NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <#> NamesT ReduceM Term
    l NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <@> NamesT ReduceM Term
    psi NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <@> ((NamesT ReduceM Term, NamesT ReduceM Term)
     -> NamesT ReduceM Term -> NamesT ReduceM Term)
    -> NamesT ReduceM Term
    -> [(NamesT ReduceM Term, NamesT ReduceM Term)]
    -> NamesT ReduceM Term
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr (NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
    forall (m :: * -> *). HasBuiltins m => m Term -> m Term -> m Term
    imax (NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term)
    -> ((NamesT ReduceM Term, NamesT ReduceM Term)
        -> NamesT ReduceM Term)
    -> (NamesT ReduceM Term, NamesT ReduceM Term)
    -> NamesT ReduceM Term
    -> NamesT ReduceM Term
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (NamesT ReduceM Term, NamesT ReduceM Term) -> NamesT ReduceM Term
    forall a b. (a, b) -> a
    fst) NamesT ReduceM Term
    iz [(NamesT ReduceM Term, NamesT ReduceM Term)]
    xs
                            NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <#> String
    -> (NamesT ReduceM Term -> NamesT ReduceM Term)
    -> NamesT ReduceM Term
    forall (m :: * -> *).
    Monad m =>
    String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
    ilam String
    "o" (\ NamesT ReduceM Term
    _ -> NamesT ReduceM Term
    ty) -- the type
                            NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <@> NamesT ReduceM Term
    u NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <@> (NamesT ReduceM Term
    -> NamesT ReduceM Term
    -> NamesT ReduceM Term
    -> [(NamesT ReduceM Term, NamesT ReduceM Term)]
    -> NamesT ReduceM Term
    combine NamesT ReduceM Term
    l NamesT ReduceM Term
    ty NamesT ReduceM Term
    d [(NamesT ReduceM Term, NamesT ReduceM Term)]
    xs)
              noRed' Blocked (Arg Term)
    su = Reduced MaybeReducedArgs Term
    -> ReduceM (Reduced MaybeReducedArgs Term)
    forall a. a -> ReduceM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Reduced MaybeReducedArgs Term
     -> ReduceM (Reduced MaybeReducedArgs Term))
    -> Reduced MaybeReducedArgs Term
    -> ReduceM (Reduced MaybeReducedArgs Term)
    forall a b. (a -> b) -> a -> b
    $ MaybeReducedArgs -> Reduced MaybeReducedArgs Term
    forall no yes. no -> Reduced no yes
    NoReduction [Arg Term -> MaybeReduced (Arg Term)
    forall a. a -> MaybeReduced a
    notReduced Arg Term
    l,Blocked (Arg Term) -> MaybeReduced (Arg Term)
    reduced Blocked (Arg Term)
    sc, Blocked (Arg Term) -> MaybeReduced (Arg Term)
    reduced Blocked (Arg Term)
    sphi, Blocked (Arg Term) -> MaybeReduced (Arg Term)
    reduced Blocked (Arg Term)
    su', Blocked (Arg Term) -> MaybeReduced (Arg Term)
    reduced Blocked (Arg Term)
    sa0]
                where
                  su' :: Blocked (Arg Term)
    su' = case Term -> IntervalView
    view Term
    phi of
                         IntervalView
    IZero -> Arg Term -> Blocked (Arg Term)
    forall a t. a -> Blocked' t a
    notBlocked (Arg Term -> Blocked (Arg Term)) -> Arg Term -> Blocked (Arg Term)
    forall a b. (a -> b) -> a -> b
    $ Term -> Arg Term
    forall e. e -> Arg e
    argN (Term -> Arg Term) -> Term -> Arg 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
                                     l <- 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))
    -> (Arg Term -> Term)
    -> Arg Term
    -> NamesT Identity (NamesT Identity Term)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Arg Term -> Term
    forall e. Arg e -> e
    unArg (Arg Term -> NamesT Identity (NamesT Identity Term))
    -> Arg Term -> NamesT Identity (NamesT Identity Term)
    forall a b. (a -> b) -> a -> b
    $ Arg Term
    l
                                     c <- open . unArg . ignoreBlocking $ sc
                                     lam "i" $ \ NamesT Identity Term
    i -> Term -> NamesT Identity Term
    forall a. a -> NamesT Identity a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Term
    tEmpty NamesT Identity Term
    -> NamesT Identity Term -> NamesT Identity Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <#> NamesT Identity Term
    l
                                                                  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
    ilam String
    "o" (\ NamesT Identity Term
    _ -> NamesT Identity Term
    c)
                         IntervalView
    _     -> Blocked (Arg Term)
    su
              sameConHeadBack Maybe Term
    Nothing Maybe ConHead
    Nothing Blocked (Arg Term)
    su ConHead
    -> Blocked (Arg Term) -> ReduceM (Reduced MaybeReducedArgs Term)
    k = Blocked (Arg Term) -> ReduceM (Reduced MaybeReducedArgs Term)
    noRed' Blocked (Arg Term)
    su
              sameConHeadBack Maybe Term
    lt Maybe ConHead
    h Blocked (Arg Term)
    su ConHead
    -> Blocked (Arg Term) -> ReduceM (Reduced MaybeReducedArgs Term)
    k = do
                let u :: Term
    u = Arg Term -> Term
    forall e. Arg e -> e
    unArg (Arg Term -> Term)
    -> (Blocked (Arg Term) -> Arg Term) -> Blocked (Arg Term) -> Term
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Blocked (Arg Term) -> Arg Term
    forall t a. Blocked' t a -> a
    ignoreBlocking (Blocked (Arg Term) -> Term) -> Blocked (Arg Term) -> Term
    forall a b. (a -> b) -> a -> b
    $ Blocked (Arg Term)
    su
                (b, ts) <- (IntervalView -> Term)
    -> Term
    -> Term
    -> (Term -> (Bool, Bool))
    -> ReduceM
         ([(Bool, Bool)], [Maybe (Blocked' Term Term, IntMap Bool)])
    forall {a}.
    (IntervalView -> Term)
    -> Term
    -> Term
    -> (Term -> a)
    -> ReduceM ([a], [Maybe (Blocked' Term Term, IntMap Bool)])
    allComponentsBack IntervalView -> Term
    unview Term
    phi Term
    u ((Term -> (Bool, Bool))
     -> ReduceM
          ([(Bool, Bool)], [Maybe (Blocked' Term Term, IntMap Bool)]))
    -> (Term -> (Bool, Bool))
    -> ReduceM
         ([(Bool, Bool)], [Maybe (Blocked' Term Term, IntMap Bool)])
    forall a b. (a -> b) -> a -> b
    $ \ Term
    t ->
                            (Term -> Maybe Term
    isLit Term
    t Maybe Term -> Maybe Term -> Bool
    forall a. Eq a => a -> a -> Bool
    == Maybe Term
    lt, Term -> Maybe ConHead
    isCon (Term -> Term
    constrForm Term
    t) Maybe ConHead -> Maybe ConHead -> Bool
    forall a. Eq a => a -> a -> Bool
    == Maybe ConHead
    h)
                let
                  (lit,hd) = unzip b

                if isJust lt && and lit then redReturn a0 else do
                su <- caseMaybe (sequence ts) (return su) $ \ [(Blocked' Term Term, IntMap Bool)]
    ts -> do
                  let ([Blocked' Term Term]
    us,[IntMap Bool]
    bools) = [(Blocked' Term Term, IntMap Bool)]
    -> ([Blocked' Term Term], [IntMap Bool])
    forall a b. [(a, b)] -> ([a], [b])
    unzip [(Blocked' Term Term, IntMap Bool)]
    ts
                  (Term -> Blocked (Arg Term))
    -> ReduceM Term -> ReduceM (Blocked (Arg Term))
    forall a b. (a -> b) -> ReduceM a -> ReduceM b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (([Blocked' Term Term] -> Blocked' Term ()
    forall (t :: * -> *) (f :: * -> *) a.
    (Foldable t, Applicative f) =>
    t (f a) -> f ()
    sequenceA_ [Blocked' Term Term]
    us Blocked' Term () -> Arg Term -> Blocked (Arg Term)
    forall (f :: * -> *) a b. Functor f => f a -> b -> f b
    $>) (Arg Term -> Blocked (Arg Term))
    -> (Term -> Arg Term) -> Term -> Blocked (Arg Term)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Term -> Arg Term
    forall e. e -> Arg e
    argN) (ReduceM Term -> ReduceM (Blocked (Arg Term)))
    -> ReduceM Term -> ReduceM (Blocked (Arg Term))
    forall a b. (a -> b) -> a -> b
    $ do
                  let
                    phis :: [Term]
                    phis :: [Term]
    phis = [IntMap Bool] -> (IntMap Bool -> Term) -> [Term]
    forall (m :: * -> *) a b. Functor m => m a -> (a -> b) -> m b
    for [IntMap Bool]
    bools ((IntMap Bool -> Term) -> [Term])
    -> (IntMap Bool -> Term) -> [Term]
    forall a b. (a -> b) -> a -> b
    $ \ IntMap Bool
    m ->
                                ((Nat, Bool) -> Term -> Term) -> Term -> [(Nat, Bool)] -> Term
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr (Term -> Term -> Term
    iMin (Term -> Term -> Term)
    -> ((Nat, Bool) -> Term) -> (Nat, Bool) -> Term -> Term
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (\(Nat
    i,Bool
    b) -> Bool -> (Term -> Term) -> Term -> Term
    forall b a. IsBool b => b -> (a -> a) -> a -> a
    applyUnless Bool
    b Term -> Term
    iNeg (Term -> Term) -> Term -> Term
    forall a b. (a -> b) -> a -> b
    $ Nat -> Term
    var Nat
    i)) Term
    iO (IntMap Bool -> [(Nat, Bool)]
    forall a. IntMap a -> [(Nat, a)]
    IntMap.toList IntMap Bool
    m)
                  Names -> NamesT ReduceM Term -> ReduceM Term
    forall (m :: * -> *) a. Names -> NamesT m a -> m a
    runNamesT [] (NamesT ReduceM Term -> ReduceM Term)
    -> NamesT ReduceM Term -> ReduceM Term
    forall a b. (a -> b) -> a -> b
    $ do
                    u <- Term -> NamesT ReduceM (NamesT ReduceM Term)
    forall (m :: * -> *) a.
    (Monad m, Subst a) =>
    a -> NamesT m (NamesT m a)
    open Term
    u
                    l <- open . unArg $ l
                    c <- open . unArg $ ignoreBlocking sc
                    phis <- mapM open phis
                    us   <- mapM (open . ignoreBlocking) us
                    lam "i" $ \ NamesT ReduceM Term
    i -> do
                      NamesT ReduceM Term
    -> NamesT ReduceM Term
    -> NamesT ReduceM Term
    -> [(NamesT ReduceM Term, NamesT ReduceM Term)]
    -> NamesT ReduceM Term
    combine NamesT ReduceM Term
    l NamesT ReduceM Term
    c (NamesT ReduceM Term
    u NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <@> NamesT ReduceM Term
    i) ([(NamesT ReduceM Term, NamesT ReduceM Term)]
     -> NamesT ReduceM Term)
    -> [(NamesT ReduceM Term, NamesT ReduceM Term)]
    -> NamesT ReduceM Term
    forall a b. (a -> b) -> a -> b
    $ [NamesT ReduceM Term]
    -> [NamesT ReduceM Term]
    -> [(NamesT ReduceM Term, NamesT ReduceM Term)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [NamesT ReduceM Term]
    phis ((NamesT ReduceM Term -> NamesT ReduceM Term)
    -> [NamesT ReduceM Term] -> [NamesT ReduceM Term]
    forall a b. (a -> b) -> [a] -> [b]
    map (\ NamesT ReduceM Term
    t -> NamesT ReduceM Term
    t NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <@> NamesT ReduceM Term
    i) [NamesT ReduceM Term]
    us)

                if isJust h && and hd then k (fromMaybe __IMPOSSIBLE__ h) su
                          else noRed' su

          sameConHeadBack (isLit a0) (isCon a0) su $ \ ConHead
    h Blocked (Arg Term)
    su -> do
                let u :: Term
    u = Arg Term -> Term
    forall e. Arg e -> e
    unArg (Arg Term -> Term)
    -> (Blocked (Arg Term) -> Arg Term) -> Blocked (Arg Term) -> Term
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Blocked (Arg Term) -> Arg Term
    forall t a. Blocked' t a -> a
    ignoreBlocking (Blocked (Arg Term) -> Term) -> Blocked (Arg Term) -> Term
    forall a b. (a -> b) -> a -> b
    $ Blocked (Arg Term)
    su
                Constructor{ conComp = cm } <- Definition -> Defn
    theDef (Definition -> Defn) -> ReduceM Definition -> ReduceM Defn
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> QName -> ReduceM Definition
    forall (m :: * -> *). HasConstInfo m => QName -> m Definition
    getConstInfo (ConHead -> QName
    conName ConHead
    h)
                case nameOfHComp cm of
                  Just QName
    hcompD -> Term -> ReduceM (Reduced MaybeReducedArgs Term)
    forall a a'. a -> ReduceM (Reduced a' a)
    redReturn (Term -> ReduceM (Reduced MaybeReducedArgs Term))
    -> Term -> ReduceM (Reduced MaybeReducedArgs Term)
    forall a b. (a -> b) -> a -> b
    $ QName -> [Elim] -> Term
    Def QName
    hcompD [] Term -> [Arg Term] -> Term
    forall t. Apply t => t -> [Arg Term] -> t
    `apply`
                                              ([Arg Term]
    ps [Arg Term] -> [Arg Term] -> [Arg Term]
    forall a. [a] -> [a] -> [a]
    ++ (Term -> Arg Term) -> [Term] -> [Arg Term]
    forall a b. (a -> b) -> [a] -> [b]
    map Term -> Arg Term
    forall e. e -> Arg e
    argN [Term
    phi,Term
    u,Term
    a0])
                  Maybe QName
    Nothing        -> Blocked (Arg Term) -> ReduceM (Reduced MaybeReducedArgs Term)
    noRed' Blocked (Arg Term)
    su

        compData Maybe QName
    mtrD        Bool
    _     a
    0     Command
    DoTransp (IsFam Arg Term
    l) (IsFam [Arg Term]
    ps) Blocked (FamilyOrNot (Arg Term))
    fsc Blocked (Arg Term)
    sphi Maybe (Arg Term)
    Nothing Arg Term
    a0 = Term -> ReduceM (Reduced MaybeReducedArgs Term)
    forall a a'. a -> ReduceM (Reduced a' a)
    redReturn (Term -> ReduceM (Reduced MaybeReducedArgs Term))
    -> Term -> ReduceM (Reduced MaybeReducedArgs Term)
    forall a b. (a -> b) -> a -> b
    $ Arg Term -> Term
    forall e. Arg e -> e
    unArg Arg Term
    a0
        compData (Just QName
    trD) Bool
    isHIT a
    _ cmd :: Command
    cmd@Command
    DoTransp (IsFam Arg Term
    l) (IsFam [Arg Term]
    ps) Blocked (FamilyOrNot (Arg Term))
    fsc Blocked (Arg Term)
    sphi Maybe (Arg Term)
    Nothing Arg Term
    a0 = do
          let sc :: Blocked (Arg Term)
    sc = FamilyOrNot (Arg Term) -> Arg Term
    forall a. FamilyOrNot a -> a
    famThing (FamilyOrNot (Arg Term) -> Arg Term)
    -> Blocked (FamilyOrNot (Arg Term)) -> Blocked (Arg Term)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Blocked (FamilyOrNot (Arg Term))
    fsc
          let f :: Blocked' t (Arg c) -> c
    f = Arg c -> c
    forall e. Arg e -> e
    unArg (Arg c -> c)
    -> (Blocked' t (Arg c) -> Arg c) -> Blocked' t (Arg c) -> c
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Blocked' t (Arg c) -> Arg c
    forall t a. Blocked' t a -> a
    ignoreBlocking
              phi :: Term
              phi :: Term
    phi = Blocked (Arg Term) -> Term
    forall {t} {c}. Blocked' t (Arg c) -> c
    f (Blocked (Arg Term) -> Term) -> Blocked (Arg Term) -> Term
    forall a b. (a -> b) -> a -> b
    $ Blocked (Arg Term)
    sphi
          let lam_i :: Term -> Term
    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"
          Term -> ReduceM (Reduced MaybeReducedArgs Term)
    forall a a'. a -> ReduceM (Reduced a' a)
    redReturn (Term -> ReduceM (Reduced MaybeReducedArgs Term))
    -> Term -> ReduceM (Reduced MaybeReducedArgs Term)
    forall a b. (a -> b) -> a -> b
    $ QName -> [Elim] -> Term
    Def QName
    trD [] Term -> [Arg Term] -> Term
    forall t. Apply t => t -> [Arg Term] -> t
    `apply` ((Arg Term -> Arg Term) -> [Arg Term] -> [Arg Term]
    forall a b. (a -> b) -> [a] -> [b]
    map ((Term -> Term) -> Arg Term -> Arg Term
    forall a b. (a -> b) -> Arg a -> Arg b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Term -> Term
    lam_i) [Arg Term]
    ps [Arg Term] -> [Arg Term] -> [Arg Term]
    forall a. [a] -> [a] -> [a]
    ++ (Term -> Arg Term) -> [Term] -> [Arg Term]
    forall a b. (a -> b) -> [a] -> [b]
    map Term -> Arg Term
    forall e. e -> Arg e
    argN [Term
    phi,Arg Term -> Term
    forall e. Arg e -> e
    unArg Arg Term
    a0])

        compData Maybe QName
    mtrD Bool
    isHIT a
    _ cmd :: Command
    cmd@Command
    DoTransp (IsFam Arg Term
    l) (IsFam [Arg Term]
    ps) Blocked (FamilyOrNot (Arg Term))
    fsc Blocked (Arg Term)
    sphi Maybe (Arg Term)
    Nothing Arg Term
    a0 = do
          let getTermLocal :: IsBuiltin a => a -> ReduceM Term
              getTermLocal :: forall a. IsBuiltin a => a -> ReduceM Term
    getTermLocal = String -> a -> ReduceM Term
    forall (m :: * -> *) a.
    (HasBuiltins m, IsBuiltin a) =>
    String -> a -> m Term
    getTerm (String -> a -> ReduceM Term) -> String -> a -> ReduceM Term
    forall a b. (a -> b) -> a -> b
    $ PrimitiveId -> String
    forall a. IsBuiltin a => a -> String
    getBuiltinId PrimitiveId
    builtinTrans String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " for data types"
          let sc :: Blocked (Arg Term)
    sc = FamilyOrNot (Arg Term) -> Arg Term
    forall a. FamilyOrNot a -> a
    famThing (FamilyOrNot (Arg Term) -> Arg Term)
    -> Blocked (FamilyOrNot (Arg Term)) -> Blocked (Arg Term)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Blocked (FamilyOrNot (Arg Term))
    fsc
          mhcompName <- PrimitiveId -> ReduceM (Maybe QName)
    forall (m :: * -> *) a.
    (HasBuiltins m, IsBuiltin a) =>
    a -> m (Maybe QName)
    getName' PrimitiveId
    builtinHComp
          constrForm <- do
            mz <- getTerm' builtinZero
            ms <- getTerm' builtinSuc
            return $ \ Term
    t -> Term -> Maybe Term -> Term
    forall a. a -> Maybe a -> a
    fromMaybe Term
    t (Maybe Term -> Maybe Term -> Term -> Maybe Term
    forall (m :: * -> *).
    Applicative m =>
    m Term -> m Term -> Term -> m Term
    constructorForm' Maybe Term
    mz Maybe Term
    ms Term
    t)
          sa0 <- reduceB' a0
          let f = Arg c -> c
    forall e. Arg e -> e
    unArg (Arg c -> c)
    -> (Blocked' t (Arg c) -> Arg c) -> Blocked' t (Arg c) -> c
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Blocked' t (Arg c) -> Arg c
    forall t a. Blocked' t a -> a
    ignoreBlocking
              phi = Blocked (Arg Term) -> Term
    forall {t} {c}. Blocked' t (Arg c) -> c
    f Blocked (Arg Term)
    sphi
              a0 = Blocked (Arg Term) -> Term
    forall {t} {c}. Blocked' t (Arg c) -> c
    f Blocked (Arg Term)
    sa0
              noRed = Reduced MaybeReducedArgs Term
    -> ReduceM (Reduced MaybeReducedArgs Term)
    forall a. a -> ReduceM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Reduced MaybeReducedArgs Term
     -> ReduceM (Reduced MaybeReducedArgs Term))
    -> Reduced MaybeReducedArgs Term
    -> ReduceM (Reduced MaybeReducedArgs Term)
    forall a b. (a -> b) -> a -> b
    $ MaybeReducedArgs -> Reduced MaybeReducedArgs Term
    forall no yes. no -> Reduced no yes
    NoReduction [Arg Term -> MaybeReduced (Arg Term)
    forall a. a -> MaybeReduced a
    notReduced Arg Term
    l,Blocked (Arg Term) -> MaybeReduced (Arg Term)
    reduced Blocked (Arg Term)
    sc, Blocked (Arg Term) -> MaybeReduced (Arg Term)
    reduced Blocked (Arg Term)
    sphi, Blocked (Arg Term) -> MaybeReduced (Arg Term)
    reduced Blocked (Arg Term)
    sa0]
          let 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"
          case constrForm a0 of
            Con ConHead
    h ConInfo
    _ [Elim]
    args -> do
              Constructor{ conComp = cm } <- Definition -> Defn
    theDef (Definition -> Defn) -> ReduceM Definition -> ReduceM Defn
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> QName -> ReduceM Definition
    forall (m :: * -> *). HasConstInfo m => QName -> m Definition
    getConstInfo (ConHead -> QName
    conName ConHead
    h)
              case nameOfTransp cm of
                  Just QName
    transpD -> Term -> ReduceM (Reduced MaybeReducedArgs Term)
    forall a a'. a -> ReduceM (Reduced a' a)
    redReturn (Term -> ReduceM (Reduced MaybeReducedArgs Term))
    -> Term -> ReduceM (Reduced MaybeReducedArgs Term)
    forall a b. (a -> b) -> a -> b
    $ QName -> [Elim] -> Term
    Def QName
    transpD [] Term -> [Arg Term] -> Term
    forall t. Apply t => t -> [Arg Term] -> t
    `apply`
                                              ((Arg Term -> Arg Term) -> [Arg Term] -> [Arg Term]
    forall a b. (a -> b) -> [a] -> [b]
    map ((Term -> Term) -> Arg Term -> Arg Term
    forall a b. (a -> b) -> Arg a -> Arg b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Term -> Term
    lam_i) [Arg Term]
    ps [Arg Term] -> [Arg Term] -> [Arg Term]
    forall a. [a] -> [a] -> [a]
    ++ (Term -> Arg Term) -> [Term] -> [Arg Term]
    forall a b. (a -> b) -> [a] -> [b]
    map Term -> Arg Term
    forall e. e -> Arg e
    argN [Term
    phi,Term
    a0])
                  Maybe QName
    Nothing        -> ReduceM (Reduced MaybeReducedArgs Term)
    noRed
            Def QName
    q [Elim]
    es | Bool
    isHIT, QName -> Maybe QName
    forall a. a -> Maybe a
    Just QName
    q Maybe QName -> Maybe QName -> Bool
    forall a. Eq a => a -> a -> Bool
    == Maybe QName
    mhcompName, Just [Arg Term
    _l0,Arg Term
    _c0,Arg Term
    psi,Arg Term
    u,Arg Term
    u0] <- [Elim] -> Maybe [Arg Term]
    forall a. [Elim' a] -> Maybe [Arg a]
    allApplyElims [Elim]
    es -> do
               let bC :: Arg Term
    bC = Blocked (Arg Term) -> Arg Term
    forall t a. Blocked' t a -> a
    ignoreBlocking Blocked (Arg Term)
    sc
               hcomp <- PrimitiveId -> ReduceM Term
    forall a. IsBuiltin a => a -> ReduceM Term
    getTermLocal PrimitiveId
    builtinHComp
               transp <- getTermLocal builtinTrans
               io <- getTermLocal builtinIOne
               iz <- getTermLocal builtinIZero
               redReturn <=< runNamesT [] $ do
                 l   <- open . unArg $ l
                 bC  <- open . unArg $ bC
                 phi <- open . unArg $ ignoreBlocking sphi
                 psi <- open . unArg $ psi
                 u   <- open . unArg $ u
                 u0  <- open . unArg $ u0
                 -- hcomp (sc 1) [psi |-> transp sc phi u] (transp sc phi u0)
                 pure hcomp <#> (l <@> pure io) <#> (bC <@> pure io) <#> psi
                       <@> lam "j" (\ NamesT ReduceM Term
    j -> String
    -> (NamesT ReduceM Term -> NamesT ReduceM Term)
    -> NamesT ReduceM Term
    forall (m :: * -> *).
    Monad m =>
    String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
    ilam String
    "o" ((NamesT ReduceM Term -> NamesT ReduceM Term)
     -> NamesT ReduceM Term)
    -> (NamesT ReduceM Term -> NamesT ReduceM Term)
    -> NamesT ReduceM Term
    forall a b. (a -> b) -> a -> b
    $ \ NamesT ReduceM Term
    o ->
                            Term -> NamesT ReduceM Term
    forall a. a -> NamesT ReduceM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Term
    transp NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <#> NamesT ReduceM Term
    l NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <@> NamesT ReduceM Term
    bC NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <@> NamesT ReduceM Term
    phi NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <@> (NamesT ReduceM Term
    u NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <@> NamesT ReduceM Term
    j NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <..> NamesT ReduceM Term
    o))
                       <@> (pure transp <#> l <@> bC <@> phi <@> u0)
            Term
    _ -> ReduceM (Reduced MaybeReducedArgs Term)
    noRed
        compData Maybe QName
    mtrX Bool
    isHITorIx a
    nargs Command
    cmd FamilyOrNot (Arg Term)
    l FamilyOrNot [Arg Term]
    t Blocked (FamilyOrNot (Arg Term))
    sbA Blocked (Arg Term)
    sphi Maybe (Arg Term)
    u Arg Term
    u0 = do
          () <- String -> Nat -> TCMT IO Doc -> ReduceM ()
    forall (m :: * -> *).
    MonadDebug m =>
    String -> Nat -> TCMT IO Doc -> m ()
    reportSDoc String
    "impossible" Nat
    10 (TCMT IO Doc -> ReduceM ()) -> TCMT IO Doc -> ReduceM ()
    forall a b. (a -> b) -> a -> b
    $ TCMT IO Doc
    "compData" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> (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) -> [TCMT IO Doc] -> TCMT IO Doc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [TCMT IO Doc] -> TCMT IO Doc
    forall (m :: * -> *) (t :: * -> *).
    (Applicative m, Foldable t) =>
    t (m Doc) -> m Doc
    vcat)
           [ TCMT IO Doc
    "mtrX:       " TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> Maybe QName -> TCMT IO Doc
    forall (m :: * -> *) a. (Applicative m, Pretty a) => a -> m Doc
    pretty Maybe QName
    mtrX
           , TCMT IO Doc
    "isHITorIx:  " TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> Bool -> TCMT IO Doc
    forall (m :: * -> *) a. (Applicative m, Pretty a) => a -> m Doc
    pretty Bool
    isHITorIx
           , TCMT IO Doc
    "nargs:      " TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> a -> TCMT IO Doc
    forall (m :: * -> *) a. (Applicative m, Pretty a) => a -> m Doc
    pretty a
    nargs
           , TCMT IO Doc
    "cmd:        " 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 (Command -> String
    forall a. Show a => a -> String
    show Command
    cmd)
           , TCMT IO Doc
    "l:          " TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> FamilyOrNot (Arg Term) -> TCMT IO Doc
    forall p a. IsString p => FamilyOrNot a -> p
    familyOrNot FamilyOrNot (Arg Term)
    l
           , TCMT IO Doc
    "t:          " TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> FamilyOrNot [Arg Term] -> TCMT IO Doc
    forall p a. IsString p => FamilyOrNot a -> p
    familyOrNot FamilyOrNot [Arg Term]
    t TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> [Arg Term] -> TCMT IO Doc
    forall (m :: * -> *) a. (Applicative m, Pretty a) => a -> m Doc
    pretty (FamilyOrNot [Arg Term] -> [Arg Term]
    forall a. FamilyOrNot a -> a
    famThing FamilyOrNot [Arg Term]
    t)
           , TCMT IO Doc
    "sbA:          " TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> FamilyOrNot (Arg Term) -> TCMT IO Doc
    forall p a. IsString p => FamilyOrNot a -> p
    familyOrNot (Blocked (FamilyOrNot (Arg Term)) -> FamilyOrNot (Arg Term)
    forall t a. Blocked' t a -> a
    ignoreBlocking (Blocked (FamilyOrNot (Arg Term)) -> FamilyOrNot (Arg Term))
    -> Blocked (FamilyOrNot (Arg Term)) -> FamilyOrNot (Arg Term)
    forall a b. (a -> b) -> a -> b
    $ Blocked (FamilyOrNot (Arg Term))
    sbA)
           , TCMT IO Doc
    "sphi:       " TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> Arg Term -> TCMT IO Doc
    forall (m :: * -> *) a. (Applicative m, Pretty a) => a -> m Doc
    pretty (Blocked (Arg Term) -> Arg Term
    forall t a. Blocked' t a -> a
    ignoreBlocking Blocked (Arg Term)
    sphi)
           , TCMT IO Doc
    "isJust u:   " TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> Bool -> TCMT IO Doc
    forall (m :: * -> *) a. (Applicative m, Pretty a) => a -> m Doc
    pretty (Maybe (Arg Term) -> Bool
    forall a. Maybe a -> Bool
    isJust Maybe (Arg Term)
    u)
           , TCMT IO Doc
    "u0:         " TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> Arg Term -> TCMT IO Doc
    forall (m :: * -> *) a. (Applicative m, Pretty a) => a -> m Doc
    pretty Arg Term
    u0
           ]
          __IMPOSSIBLE__

    --    compData _ _ _ _ _ _ _ _ _ _ = __IMPOSSIBLE__

    -- | CCHM 'primComp' is implemented in terms of 'hcomp' and 'transport'.
    -- The definition of it comes from 'mkComp'.
    primComp :: TCM PrimitiveImpl
    primComp :: TCM PrimitiveImpl
    primComp = do
      Cubical -> TCM ()
    requireCubical Cubical
    CErased
      t    <- Names -> NamesT (TCMT IO) Type -> TCMT IO Type
    forall (m :: * -> *) a. Names -> NamesT m a -> m a
    runNamesT [] (NamesT (TCMT IO) Type -> TCMT IO Type)
    -> NamesT (TCMT IO) Type -> TCMT IO Type
    forall a b. (a -> b) -> a -> b
    $
              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
    hPi' String
    "a" (NamesT (TCMT IO) Type
    forall (m :: * -> *).
    (HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
    m Type
    primIntervalType 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) Sort
    -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
    forall (m :: * -> *). Applicative m => m Sort -> m Term -> m Type
    els (Sort -> NamesT (TCMT IO) Sort
    forall a. a -> NamesT (TCMT IO) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Sort
    forall t. Sort' t
    LevelUniv) (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
    primLevel)) ((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
    a ->
              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
    "A" (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 -> 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
    i -> (Sort -> Type
    sort (Sort -> Type) -> (Term -> Sort) -> Term -> Type
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Term -> Sort
    tmSort (Term -> Type) -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (NamesT (TCMT IO) Term
    a 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) 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
    bA ->
              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
    hPi' String
    "φ" NamesT (TCMT IO) Type
    forall (m :: * -> *).
    (HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
    m Type
    primIntervalType ((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
    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) Term
    -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Type
    el' (NamesT (TCMT IO) Term
    a 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
    bA 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) Type
    -> NamesT (TCMT IO) Type -> NamesT (TCMT IO) Type
    forall (m :: * -> *). Applicative m => m Type -> m Type -> m Type
    -->
              (NamesT (TCMT IO) Term
    -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Type
    el' (NamesT (TCMT IO) Term
    a NamesT (TCMT IO) Term
    -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <@> 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
    primIZero) (NamesT (TCMT IO) Term
    bA NamesT (TCMT IO) Term
    -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <@> 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
    primIZero) 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) Term
    -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Type
    el' (NamesT (TCMT IO) Term
    a NamesT (TCMT IO) Term
    -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <@> 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
    primIOne) (NamesT (TCMT IO) Term
    bA NamesT (TCMT IO) Term
    -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <@> 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
    primIOne))
      one <- primItIsOne
      io  <- primIOne
      return $ PrimImpl t $ PrimFun __IMPOSSIBLE__ 5 [] $ \[Arg Term]
    ts Nat
    nelims -> do
        case [Arg Term]
    ts of
          [Arg Term
    l,Arg Term
    c,Arg Term
    phi,Arg Term
    u,Arg Term
    a0] -> do
            sphi <- Arg Term -> ReduceM (Blocked (Arg Term))
    forall t. Reduce t => t -> ReduceM (Blocked t)
    reduceB' Arg Term
    phi
            vphi <- intervalView $ unArg $ ignoreBlocking sphi
            case vphi of
              -- Though we short-circuit evaluation for the rule
              --    comp A i1 (λ _ .1=1 → u) u ==> u
              -- rather than going through the motions of hcomp and transp.
              IntervalView
    IOne -> Term -> ReduceM (Reduced MaybeReducedArgs Term)
    forall a a'. a -> ReduceM (Reduced a' a)
    redReturn (Arg Term -> Term
    forall e. Arg e -> e
    unArg Arg Term
    u Term -> [Arg Term] -> Term
    forall t. Apply t => t -> [Arg Term] -> t
    `apply` [Term -> Arg Term
    forall e. e -> Arg e
    argN Term
    io, Term -> Arg Term
    forall e. e -> Arg e
    argN Term
    one])
              IntervalView
    _    -> do
                Term -> ReduceM (Reduced MaybeReducedArgs Term)
    forall a a'. a -> ReduceM (Reduced a' a)
    redReturnNoSimpl (Term -> ReduceM (Reduced MaybeReducedArgs Term))
    -> (NamesT ReduceM Term -> ReduceM Term)
    -> NamesT ReduceM Term
    -> ReduceM (Reduced MaybeReducedArgs Term)
    forall (m :: * -> *) b c a.
    Monad m =>
    (b -> m c) -> (a -> m b) -> a -> m c
    <=< Names -> NamesT ReduceM Term -> ReduceM Term
    forall (m :: * -> *) a. Names -> NamesT m a -> m a
    runNamesT [] (NamesT ReduceM Term -> ReduceM (Reduced MaybeReducedArgs Term))
    -> NamesT ReduceM Term -> ReduceM (Reduced MaybeReducedArgs Term)
    forall a b. (a -> b) -> a -> b
    $ do
                  comp <- String
    -> NamesT
         ReduceM
         (NamesT ReduceM Term
          -> NamesT ReduceM Term
          -> NamesT ReduceM Term
          -> NamesT ReduceM Term
          -> NamesT ReduceM Term
          -> NamesT ReduceM Term)
    forall (m :: * -> *).
    HasBuiltins m =>
    String
    -> NamesT
         m
         (NamesT m Term
          -> NamesT m Term
          -> NamesT m Term
          -> NamesT m Term
          -> NamesT m Term
          -> NamesT m Term)
    mkComp (PrimitiveId -> String
    forall a. IsBuiltin a => a -> String
    getBuiltinId PrimitiveId
    PrimComp)
                  l   <- open . unArg $ l
                  c   <- open . unArg $ c
                  phi <- open . unArg $ phi
                  u   <- open . unArg $ u
                  a0  <- open . unArg $ a0
                  comp l c phi u a0

          [Arg Term]
    _ -> ReduceM (Reduced MaybeReducedArgs Term)
    forall a. HasCallStack => a
    __IMPOSSIBLE__

    -- TODO Andrea: keep reductions that happen under foralls?
    primFaceForall' :: TCM PrimitiveImpl
    primFaceForall' :: TCM PrimitiveImpl
    primFaceForall' = do
      Cubical -> TCM ()
    requireCubical Cubical
    CErased
      t <- (TCMT IO Type
    forall (m :: * -> *).
    (HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
    m Type
    primIntervalType TCMT IO Type -> TCMT IO Type -> TCMT IO Type
    forall (m :: * -> *). Applicative m => m Type -> m Type -> m Type
    --> TCMT IO Type
    forall (m :: * -> *).
    (HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
    m Type
    primIntervalType) TCMT IO Type -> TCMT IO Type -> TCMT IO Type
    forall (m :: * -> *). Applicative m => m Type -> m Type -> m Type
    --> TCMT IO Type
    forall (m :: * -> *).
    (HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
    m Type
    primIntervalType
      return $ PrimImpl t $ primFun __IMPOSSIBLE__ 1 $ \case
        [Arg Term
    phi] -> do
          sphi <- Arg Term -> ReduceM (Blocked (Arg Term))
    forall t. Reduce t => t -> ReduceM (Blocked t)
    reduceB' Arg Term
    phi
          case unArg $ ignoreBlocking $ sphi of
            Lam ArgInfo
    _ Abs Term
    t -> do
              t <- Abs Term -> ReduceM (Abs Term)
    forall t. Reduce t => t -> ReduceM t
    reduce' Abs Term
    t
              case t of
                NoAbs String
    _ Term
    t -> Term -> ReduceM (Reduced MaybeReducedArgs Term)
    forall a a'. a -> ReduceM (Reduced a' a)
    redReturn Term
    t
                Abs String
    _ Term
    t ->
                  ReduceM (Reduced MaybeReducedArgs Term)
    -> (Term -> ReduceM (Reduced MaybeReducedArgs Term))
    -> Maybe Term
    -> ReduceM (Reduced MaybeReducedArgs Term)
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe (Reduced MaybeReducedArgs Term
    -> ReduceM (Reduced MaybeReducedArgs Term)
    forall a. a -> ReduceM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Reduced MaybeReducedArgs Term
     -> ReduceM (Reduced MaybeReducedArgs Term))
    -> Reduced MaybeReducedArgs Term
    -> ReduceM (Reduced MaybeReducedArgs Term)
    forall a b. (a -> b) -> a -> b
    $ MaybeReducedArgs -> Reduced MaybeReducedArgs Term
    forall no yes. no -> Reduced no yes
    NoReduction [Blocked (Arg Term) -> MaybeReduced (Arg Term)
    reduced Blocked (Arg Term)
    sphi]) Term -> ReduceM (Reduced MaybeReducedArgs Term)
    forall a a'. a -> ReduceM (Reduced a' a)
    redReturn
                    (Maybe Term -> ReduceM (Reduced MaybeReducedArgs Term))
    -> ReduceM (Maybe Term) -> ReduceM (Reduced MaybeReducedArgs Term)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< Term -> ReduceM (Maybe Term)
    forall {m :: * -> *}. HasBuiltins m => Term -> m (Maybe Term)
    toFaceMapsPrim Term
    t
            Term
    _ -> Reduced MaybeReducedArgs Term
    -> ReduceM (Reduced MaybeReducedArgs Term)
    forall a. a -> ReduceM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (MaybeReducedArgs -> Reduced MaybeReducedArgs Term
    forall no yes. no -> Reduced no yes
    NoReduction [Blocked (Arg Term) -> MaybeReduced (Arg Term)
    reduced Blocked (Arg Term)
    sphi])
        [Arg Term]
    _ -> ReduceM (Reduced MaybeReducedArgs Term)
    forall a. HasCallStack => a
    __IMPOSSIBLE__
      where
        toFaceMapsPrim :: Term -> m (Maybe Term)
    toFaceMapsPrim Term
    t = do
          view <- m (Term -> IntervalView)
    forall (m :: * -> *). HasBuiltins m => m (Term -> IntervalView)
    intervalView'
          unview <- intervalUnview'
          us' <- decomposeInterval t
          fr <- getTerm (getBuiltinId PrimFaceForall) PrimFaceForall
          let
            v = Term -> IntervalView
    view Term
    t
            -- We decomposed the interval expression, without regard for
            -- inconsistent mappings, and now we keep only those which are
            -- stuck (the ts) and those which do not mention the 0th variable.
            us :: [[Either (Int, Bool) Term]]
            us = [ ((Nat, Bool) -> Either (Nat, Bool) Term)
    -> [(Nat, Bool)] -> [Either (Nat, Bool) Term]
    forall a b. (a -> b) -> [a] -> [b]
    map (Nat, Bool) -> Either (Nat, Bool) Term
    forall a b. a -> Either a b
    Left (IntMap Bool -> [(Nat, Bool)]
    forall a. IntMap a -> [(Nat, a)]
    IntMap.toList IntMap Bool
    bsm) [Either (Nat, Bool) Term]
    -> [Either (Nat, Bool) Term] -> [Either (Nat, Bool) Term]
    forall a. [a] -> [a] -> [a]
    ++ (Term -> Either (Nat, Bool) Term)
    -> [Term] -> [Either (Nat, Bool) Term]
    forall a b. (a -> b) -> [a] -> [b]
    map Term -> Either (Nat, Bool) Term
    forall a b. b -> Either a b
    Right [Term]
    ts
                 | (IntMap Bool
    bsm, [Term]
    ts) <- [(IntMap Bool, [Term])]
    us', Nat
    0 Nat -> IntMap Bool -> Bool
    forall a. Nat -> IntMap a -> Bool
    `IntMap.notMember` IntMap Bool
    bsm
                 ]

            -- Turn a face mapping back into an interval expression:
            fm (Nat
    i, Bool
    b) = if Bool
    b then Nat -> Term
    var (Nat
    i Nat -> Nat -> Nat
    forall a. Num a => a -> a -> a
    - Nat
    1) else IntervalView -> Term
    unview (Arg Term -> IntervalView
    INeg (Term -> Arg Term
    forall e. e -> Arg e
    argN (Nat -> Term
    var (Nat -> Term) -> Nat -> Term
    forall a b. (a -> b) -> a -> b
    $ Nat
    i Nat -> Nat -> Nat
    forall a. Num a => a -> a -> a
    - Nat
    1)))
            -- Apply ∀ to any indecomposable expressions we have encountered
            ffr Term
    t = Term
    fr 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
    $ 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
    t]

            -- Unfold one step of the foldr to avoid generation of the last
            -- ∧ i1. Marginal savings at best but it's cleaner.
            conjuncts :: [Either (Int, Bool) Term] -> Term
            conjuncts [] = IntervalView -> Term
    unview IntervalView
    IOne
            conjuncts [Either (Nat, Bool) Term
    x] = ((Nat, Bool) -> Term)
    -> (Term -> Term) -> Either (Nat, Bool) Term -> Term
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either (Nat, Bool) -> Term
    fm Term -> Term
    ffr Either (Nat, Bool) Term
    x
            conjuncts (Either (Nat, Bool) Term
    x:[Either (Nat, Bool) Term]
    xs) =
              (Either (Nat, Bool) Term -> Term -> Term)
    -> Term -> [Either (Nat, Bool) Term] -> Term
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr (\Either (Nat, Bool) Term
    x Term
    r -> IntervalView -> Term
    unview (Arg Term -> Arg Term -> IntervalView
    IMin (Term -> Arg Term
    forall e. e -> Arg e
    argN (((Nat, Bool) -> Term)
    -> (Term -> Term) -> Either (Nat, Bool) Term -> Term
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either (Nat, Bool) -> Term
    fm Term -> Term
    ffr Either (Nat, Bool) Term
    x)) (Term -> Arg Term
    forall e. e -> Arg e
    argN Term
    r)))
                (((Nat, Bool) -> Term)
    -> (Term -> Term) -> Either (Nat, Bool) Term -> Term
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either (Nat, Bool) -> Term
    fm Term -> Term
    ffr Either (Nat, Bool) Term
    x)
                [Either (Nat, Bool) Term]
    xs

            disjuncts = ([Either (Nat, Bool) Term] -> Term -> Term)
    -> Term -> [[Either (Nat, Bool) Term]] -> Term
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr
              (\[Either (Nat, Bool) Term]
    conj Term
    rest -> IntervalView -> Term
    unview (Arg Term -> Arg Term -> IntervalView
    IMax (Term -> Arg Term
    forall e. e -> Arg e
    argN ([Either (Nat, Bool) Term] -> Term
    conjuncts [Either (Nat, Bool) Term]
    conj)) (Term -> Arg Term
    forall e. e -> Arg e
    argN Term
    rest)))
              (IntervalView -> Term
    unview IntervalView
    IZero)
              [[Either (Nat, Bool) Term]]
    us
          --   traceSLn "cube.forall" 20 (unlines [show v, show us', show us, show r]) $
          return $ case us' of
            [(IntMap Bool
    m, [Term
    _])] | IntMap Bool -> Bool
    forall a. Null a => a -> Bool
    null IntMap Bool
    m -> Maybe Term
    forall a. Maybe a
    Nothing
            [(IntMap Bool, [Term])]
    _ -> Term -> Maybe Term
    forall a. a -> Maybe a
    Just Term
    disjuncts

    -- | Tries to @primTransp@ a whole telescope of arguments, following the rule for Σ types.
    --   If a type in the telescope does not support transp, @transpTel@ throws it as an exception.
    transpTel :: Abs Telescope -- Γ ⊢ i.Δ
              -> Term          -- Γ ⊢ φ : F  -- i.Δ const on φ
              -> Args          -- Γ ⊢ δ : Δ[0]
              -> ExceptT (Closure (Abs Type)) TCM Args      -- Γ ⊢ Δ[1]
    transpTel :: Abs Telescope
    -> Term
    -> [Arg Term]
    -> ExceptT (Closure (Abs Type)) (TCMT IO) [Arg Term]
    transpTel = Bool
    -> Abs Telescope
    -> Term
    -> [Arg Term]
    -> ExceptT (Closure (Abs Type)) (TCMT IO) [Arg Term]
    forall (m :: * -> *).
    (PureTCM m, MonadError TCErr m) =>
    Bool
    -> Abs Telescope
    -> Term
    -> [Arg Term]
    -> ExceptT (Closure (Abs Type)) m [Arg Term]
    transpTel' Bool
    False

    transpTel' :: (PureTCM m, MonadError TCErr m) =>
              Bool -> Abs Telescope -- Γ ⊢ i.Δ
              -> Term          -- Γ ⊢ φ : F  -- i.Δ const on φ
              -> Args          -- Γ ⊢ δ : Δ[0]
              -> ExceptT (Closure (Abs Type)) m Args      -- Γ ⊢ Δ[1]
    transpTel' :: forall (m :: * -> *).
    (PureTCM m, MonadError TCErr m) =>
    Bool
    -> Abs Telescope
    -> Term
    -> [Arg Term]
    -> ExceptT (Closure (Abs Type)) m [Arg Term]
    transpTel' Bool
    flag Abs Telescope
    delta Term
    phi [Arg Term]
    args = Bool
    -> Abs Telescope
    -> [(Term, Abs [Term])]
    -> Term
    -> [Arg Term]
    -> ExceptT (Closure (Abs Type)) m [Arg Term]
    forall (m :: * -> *).
    (PureTCM m, MonadError TCErr m) =>
    Bool
    -> Abs Telescope
    -> [(Term, Abs [Term])]
    -> Term
    -> [Arg Term]
    -> ExceptT (Closure (Abs Type)) m [Arg Term]
    transpSysTel' Bool
    flag Abs Telescope
    delta [] Term
    phi [Arg Term]
    args

    type LM m a = NamesT (ExceptT (Closure (Abs Type)) m) a
    -- transporting with an extra system/partial element
    -- or composing when some of the system is known to be constant.
    transpSysTel' :: forall m. (PureTCM m, MonadError TCErr m) =>
              Bool
              -> Abs Telescope -- Γ ⊢ i.Δ
              -> [(Term,Abs [Term])] -- [(ψ,i.δ)] with  Γ,ψ ⊢ i.δ : [i : I]. Δ[i]  -- the proof of [ψ] is not in scope.
              -> Term          -- Γ ⊢ φ : F  -- i.Δ const on φ and all i.δ const on φ ∧ ψ
              -> Args          -- Γ ⊢ δ : Δ[0]
              -> ExceptT (Closure (Abs Type)) m Args      -- Γ ⊢ Δ[1]
    transpSysTel' :: forall (m :: * -> *).
    (PureTCM m, MonadError TCErr m) =>
    Bool
    -> Abs Telescope
    -> [(Term, Abs [Term])]
    -> Term
    -> [Arg Term]
    -> ExceptT (Closure (Abs Type)) m [Arg Term]
    transpSysTel' Bool
    flag Abs Telescope
    delta [(Term, Abs [Term])]
    us Term
    phi [Arg Term]
    args = do
      String -> Nat -> TCMT IO Doc -> ExceptT (Closure (Abs Type)) m ()
    forall (m :: * -> *).
    MonadDebug m =>
    String -> Nat -> TCMT IO Doc -> m ()
    reportSDoc String
    "cubical.prim.transpTel" Nat
    20 (TCMT IO Doc -> ExceptT (Closure (Abs Type)) m ())
    -> TCMT IO Doc -> ExceptT (Closure (Abs Type)) 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 [ String -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => String -> m Doc
    text String
    "transpSysTel'"
              , (String -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => String -> m Doc
    text String
    "delta  =" 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 a b. (a -> b) -> a -> b
    $ 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
    $ (String, Dom' Term 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' Term Type) -> m a -> m a
    addContext (String
    "i" :: String, Dom' Term Type
    HasCallStack => Dom' Term Type
    __DUMMY_DOM__) (TCMT IO Doc -> TCMT IO Doc) -> TCMT IO Doc -> TCMT IO Doc
    forall a b. (a -> b) -> a -> b
    $ Telescope -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    forall (m :: * -> *). MonadPretty m => Telescope -> m Doc
    prettyTCM (Abs Telescope -> Telescope
    forall a. Abs a -> a
    unAbs Abs Telescope
    delta)
    --          , (text "us =" <+>) $ nest 2 $ prettyList $ map prettyTCM us
              , (String -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => String -> m Doc
    text String
    "phi    =" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+>) (TCMT IO Doc -> TCMT IO Doc) -> TCMT IO Doc -> TCMT IO Doc
    forall a b. (a -> b) -> a -> b
    $ 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
    $ Term -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    forall (m :: * -> *). MonadPretty m => Term -> m Doc
    prettyTCM Term
    phi
              , (String -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => String -> m Doc
    text String
    "args   =" 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 a b. (a -> b) -> a -> b
    $ 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
    prettyList ([TCMT IO Doc] -> TCMT IO Doc) -> [TCMT IO Doc] -> TCMT IO Doc
    forall a b. (a -> b) -> a -> b
    $ (Arg Term -> TCMT IO Doc) -> [Arg Term] -> [TCMT IO Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map Arg Term -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    forall (m :: * -> *). MonadPretty m => Arg Term -> m Doc
    prettyTCM [Arg Term]
    args
              ]
      let getTermLocal :: IsBuiltin a => a -> ExceptT e m Term
          getTermLocal :: forall a e. IsBuiltin a => a -> ExceptT e m Term
    getTermLocal = String -> a -> ExceptT e m Term
    forall (m :: * -> *) a.
    (HasBuiltins m, IsBuiltin a) =>
    String -> a -> m Term
    getTerm String
    "transpSys"
      tTransp <- m Term -> ExceptT (Closure (Abs Type)) m Term
    forall (m :: * -> *) a.
    Monad m =>
    m a -> ExceptT (Closure (Abs Type)) m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift m Term
    forall (m :: * -> *).
    (HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
    m Term
    primTrans
      tComp <- getTermLocal builtinComp
      tPOr <- getTermLocal builtinPOr
      iz <- lift primIZero
      imin <- lift primIMin
      imax <- lift primIMax
      ineg <- lift primINeg
      let
        noTranspError Abs a
    t = do
          String -> Nat -> TCMT IO Doc -> t m ()
    forall (m :: * -> *).
    MonadDebug m =>
    String -> Nat -> TCMT IO Doc -> m ()
    reportSDoc String
    "cubical.prim.transpTel.error" Nat
    20 (TCMT IO Doc -> t m ()) -> TCMT IO Doc -> t m ()
    forall a b. (a -> b) -> a -> b
    $ 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
    $ (String -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => String -> m Doc
    text String
    "error type =" 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 a b. (a -> b) -> a -> b
    $
            (String, Dom' Term 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' Term Type) -> m a -> m a
    addContext (String
    "i" :: String, Dom' Term Type
    HasCallStack => Dom' Term Type
    __DUMMY_DOM__) (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 -> TCMT IO Doc) -> a -> TCMT IO Doc
    forall a b. (a -> b) -> a -> b
    $ Abs a -> a
    forall a. Abs a -> a
    unAbs Abs a
    t
          m b -> t m b
    forall (m :: * -> *) a. Monad m => m a -> t m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (m b -> t m b)
    -> (Closure (Abs a) -> m b) -> Closure (Abs a) -> t m b
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Closure (Abs a) -> m b
    forall a. Closure (Abs a) -> m a
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError (Closure (Abs a) -> t m b) -> t m (Closure (Abs a)) -> t m b
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< Abs a -> t m (Closure (Abs a))
    forall (m :: * -> *) a.
    (MonadTCEnv m, ReadTCState m) =>
    a -> m (Closure a)
    buildClosure Abs a
    t
        bapp :: forall m a. (Applicative m, Subst a) => m (Abs a) -> m (SubstArg a) -> m a
        bapp m (Abs a)
    t m (SubstArg a)
    u = Abs a -> SubstArg a -> a
    forall a. Subst a => Abs a -> SubstArg a -> a
    lazyAbsApp (Abs a -> SubstArg a -> a) -> m (Abs a) -> m (SubstArg a -> a)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> m (Abs a)
    t m (SubstArg a -> a) -> m (SubstArg a) -> m a
    forall a b. m (a -> b) -> m a -> m b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> m (SubstArg a)
    u
        doGTransp NamesT (ExceptT (Closure (Abs Type)) m) Term
    l NamesT (ExceptT (Closure (Abs Type)) m) (Abs Type)
    t [(NamesT (ExceptT (Closure (Abs Type)) m) Term,
      NamesT (ExceptT (Closure (Abs Type)) m) (Abs Term))]
    us NamesT (ExceptT (Closure (Abs Type)) m) Term
    phi NamesT (ExceptT (Closure (Abs Type)) m) Term
    a | [(NamesT (ExceptT (Closure (Abs Type)) m) Term,
      NamesT (ExceptT (Closure (Abs Type)) m) (Abs Term))]
    -> Bool
    forall a. Null a => a -> Bool
    null [(NamesT (ExceptT (Closure (Abs Type)) m) Term,
      NamesT (ExceptT (Closure (Abs Type)) m) (Abs Term))]
    us = Term -> NamesT (ExceptT (Closure (Abs Type)) m) Term
    forall a. a -> NamesT (ExceptT (Closure (Abs Type)) m) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Term
    tTransp NamesT (ExceptT (Closure (Abs Type)) m) Term
    -> NamesT (ExceptT (Closure (Abs Type)) m) Term
    -> NamesT (ExceptT (Closure (Abs Type)) m) Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <#> NamesT (ExceptT (Closure (Abs Type)) m) Term
    l NamesT (ExceptT (Closure (Abs Type)) m) Term
    -> NamesT (ExceptT (Closure (Abs Type)) m) Term
    -> NamesT (ExceptT (Closure (Abs Type)) m) Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <@> (ArgInfo -> Abs Term -> Term
    Lam ArgInfo
    defaultArgInfo (Abs Term -> Term) -> (Abs Type -> Abs Term) -> Abs Type -> Term
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Type -> Term) -> Abs Type -> Abs Term
    forall a b. (a -> b) -> Abs a -> Abs b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Type -> Term
    forall t a. Type'' t a -> a
    unEl (Abs Type -> Term)
    -> NamesT (ExceptT (Closure (Abs Type)) m) (Abs Type)
    -> NamesT (ExceptT (Closure (Abs Type)) m) Term
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> NamesT (ExceptT (Closure (Abs Type)) m) (Abs Type)
    t) NamesT (ExceptT (Closure (Abs Type)) m) Term
    -> NamesT (ExceptT (Closure (Abs Type)) m) Term
    -> NamesT (ExceptT (Closure (Abs Type)) m) Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <@> NamesT (ExceptT (Closure (Abs Type)) m) Term
    phi NamesT (ExceptT (Closure (Abs Type)) m) Term
    -> NamesT (ExceptT (Closure (Abs Type)) m) Term
    -> NamesT (ExceptT (Closure (Abs Type)) m) Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <@> NamesT (ExceptT (Closure (Abs Type)) m) Term
    a
                               | Bool
    otherwise = Term -> NamesT (ExceptT (Closure (Abs Type)) m) Term
    forall a. a -> NamesT (ExceptT (Closure (Abs Type)) m) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Term
    tComp NamesT (ExceptT (Closure (Abs Type)) m) Term
    -> NamesT (ExceptT (Closure (Abs Type)) m) Term
    -> NamesT (ExceptT (Closure (Abs Type)) m) Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <#> NamesT (ExceptT (Closure (Abs Type)) m) Term
    l NamesT (ExceptT (Closure (Abs Type)) m) Term
    -> NamesT (ExceptT (Closure (Abs Type)) m) Term
    -> NamesT (ExceptT (Closure (Abs Type)) m) Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <@> (ArgInfo -> Abs Term -> Term
    Lam ArgInfo
    defaultArgInfo (Abs Term -> Term) -> (Abs Type -> Abs Term) -> Abs Type -> Term
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Type -> Term) -> Abs Type -> Abs Term
    forall a b. (a -> b) -> Abs a -> Abs b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Type -> Term
    forall t a. Type'' t a -> a
    unEl (Abs Type -> Term)
    -> NamesT (ExceptT (Closure (Abs Type)) m) (Abs Type)
    -> NamesT (ExceptT (Closure (Abs Type)) m) Term
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> NamesT (ExceptT (Closure (Abs Type)) m) (Abs Type)
    t) NamesT (ExceptT (Closure (Abs Type)) m) Term
    -> NamesT (ExceptT (Closure (Abs Type)) m) Term
    -> NamesT (ExceptT (Closure (Abs Type)) m) Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <#> NamesT (ExceptT (Closure (Abs Type)) m) Term
    face NamesT (ExceptT (Closure (Abs Type)) m) Term
    -> NamesT (ExceptT (Closure (Abs Type)) m) Term
    -> NamesT (ExceptT (Closure (Abs Type)) m) Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <@> NamesT (ExceptT (Closure (Abs Type)) m) Term
    uphi NamesT (ExceptT (Closure (Abs Type)) m) Term
    -> NamesT (ExceptT (Closure (Abs Type)) m) Term
    -> NamesT (ExceptT (Closure (Abs Type)) m) Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <@> NamesT (ExceptT (Closure (Abs Type)) m) Term
    a
          where
            -- [phi -> a; us]
            face :: NamesT (ExceptT (Closure (Abs Type)) m) Term
    face = (NamesT (ExceptT (Closure (Abs Type)) m) Term
     -> NamesT (ExceptT (Closure (Abs Type)) m) Term
     -> NamesT (ExceptT (Closure (Abs Type)) m) Term)
    -> NamesT (ExceptT (Closure (Abs Type)) m) Term
    -> [NamesT (ExceptT (Closure (Abs Type)) m) Term]
    -> NamesT (ExceptT (Closure (Abs Type)) m) Term
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr (\ NamesT (ExceptT (Closure (Abs Type)) m) Term
    x NamesT (ExceptT (Closure (Abs Type)) m) Term
    y -> Term -> NamesT (ExceptT (Closure (Abs Type)) m) Term
    forall a. a -> NamesT (ExceptT (Closure (Abs Type)) m) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Term
    imax NamesT (ExceptT (Closure (Abs Type)) m) Term
    -> NamesT (ExceptT (Closure (Abs Type)) m) Term
    -> NamesT (ExceptT (Closure (Abs Type)) m) Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <@> NamesT (ExceptT (Closure (Abs Type)) m) Term
    x NamesT (ExceptT (Closure (Abs Type)) m) Term
    -> NamesT (ExceptT (Closure (Abs Type)) m) Term
    -> NamesT (ExceptT (Closure (Abs Type)) m) Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <@> NamesT (ExceptT (Closure (Abs Type)) m) Term
    y) (Term -> NamesT (ExceptT (Closure (Abs Type)) m) Term
    forall a. a -> NamesT (ExceptT (Closure (Abs Type)) m) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Term
    iz) (NamesT (ExceptT (Closure (Abs Type)) m) Term
    phi NamesT (ExceptT (Closure (Abs Type)) m) Term
    -> [NamesT (ExceptT (Closure (Abs Type)) m) Term]
    -> [NamesT (ExceptT (Closure (Abs Type)) m) Term]
    forall a. a -> [a] -> [a]
    : ((NamesT (ExceptT (Closure (Abs Type)) m) Term,
      NamesT (ExceptT (Closure (Abs Type)) m) (Abs Term))
     -> NamesT (ExceptT (Closure (Abs Type)) m) Term)
    -> [(NamesT (ExceptT (Closure (Abs Type)) m) Term,
         NamesT (ExceptT (Closure (Abs Type)) m) (Abs Term))]
    -> [NamesT (ExceptT (Closure (Abs Type)) m) Term]
    forall a b. (a -> b) -> [a] -> [b]
    map (NamesT (ExceptT (Closure (Abs Type)) m) Term,
     NamesT (ExceptT (Closure (Abs Type)) m) (Abs Term))
    -> NamesT (ExceptT (Closure (Abs Type)) m) Term
    forall a b. (a, b) -> a
    fst [(NamesT (ExceptT (Closure (Abs Type)) m) Term,
      NamesT (ExceptT (Closure (Abs Type)) m) (Abs Term))]
    us)
            uphi :: NamesT (ExceptT (Closure (Abs Type)) m) Term
    uphi = String
    -> (NamesT (ExceptT (Closure (Abs Type)) m) Term
        -> NamesT (ExceptT (Closure (Abs Type)) m) Term)
    -> NamesT (ExceptT (Closure (Abs Type)) m) Term
    forall (m :: * -> *).
    Monad m =>
    String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
    lam String
    "i" ((NamesT (ExceptT (Closure (Abs Type)) m) Term
      -> NamesT (ExceptT (Closure (Abs Type)) m) Term)
     -> NamesT (ExceptT (Closure (Abs Type)) m) Term)
    -> (NamesT (ExceptT (Closure (Abs Type)) m) Term
        -> NamesT (ExceptT (Closure (Abs Type)) m) Term)
    -> NamesT (ExceptT (Closure (Abs Type)) m) Term
    forall a b. (a -> b) -> a -> b
    $ \ NamesT (ExceptT (Closure (Abs Type)) m) Term
    i -> String
    -> (NamesT (ExceptT (Closure (Abs Type)) m) Term
        -> NamesT (ExceptT (Closure (Abs Type)) m) Term)
    -> NamesT (ExceptT (Closure (Abs Type)) m) Term
    forall (m :: * -> *).
    Monad m =>
    String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
    ilam String
    "o" ((NamesT (ExceptT (Closure (Abs Type)) m) Term
      -> NamesT (ExceptT (Closure (Abs Type)) m) Term)
     -> NamesT (ExceptT (Closure (Abs Type)) m) Term)
    -> (NamesT (ExceptT (Closure (Abs Type)) m) Term
        -> NamesT (ExceptT (Closure (Abs Type)) m) Term)
    -> NamesT (ExceptT (Closure (Abs Type)) m) Term
    forall a b. (a -> b) -> a -> b
    $ \ NamesT (ExceptT (Closure (Abs Type)) m) Term
    o -> do
              let sys' :: [(NamesT (ExceptT (Closure (Abs Type)) m) Term,
      NamesT (ExceptT (Closure (Abs Type)) m) Term)]
    sys' = (NamesT (ExceptT (Closure (Abs Type)) m) Term
    phi , NamesT (ExceptT (Closure (Abs Type)) m) Term
    a) (NamesT (ExceptT (Closure (Abs Type)) m) Term,
     NamesT (ExceptT (Closure (Abs Type)) m) Term)
    -> [(NamesT (ExceptT (Closure (Abs Type)) m) Term,
         NamesT (ExceptT (Closure (Abs Type)) m) Term)]
    -> [(NamesT (ExceptT (Closure (Abs Type)) m) Term,
         NamesT (ExceptT (Closure (Abs Type)) m) Term)]
    forall a. a -> [a] -> [a]
    : ((NamesT (ExceptT (Closure (Abs Type)) m) Term,
      NamesT (ExceptT (Closure (Abs Type)) m) (Abs Term))
     -> (NamesT (ExceptT (Closure (Abs Type)) m) Term,
         NamesT (ExceptT (Closure (Abs Type)) m) Term))
    -> [(NamesT (ExceptT (Closure (Abs Type)) m) Term,
         NamesT (ExceptT (Closure (Abs Type)) m) (Abs Term))]
    -> [(NamesT (ExceptT (Closure (Abs Type)) m) Term,
         NamesT (ExceptT (Closure (Abs Type)) m) Term)]
    forall a b. (a -> b) -> [a] -> [b]
    map ((NamesT (ExceptT (Closure (Abs Type)) m) (Abs Term)
     -> NamesT (ExceptT (Closure (Abs Type)) m) Term)
    -> (NamesT (ExceptT (Closure (Abs Type)) m) Term,
        NamesT (ExceptT (Closure (Abs Type)) m) (Abs Term))
    -> (NamesT (ExceptT (Closure (Abs Type)) m) Term,
        NamesT (ExceptT (Closure (Abs Type)) m) Term)
    forall b d a. (b -> d) -> (a, b) -> (a, d)
    mapSnd (NamesT (ExceptT (Closure (Abs Type)) m) (Abs Term)
    -> NamesT (ExceptT (Closure (Abs Type)) m) (SubstArg Term)
    -> NamesT (ExceptT (Closure (Abs Type)) m) Term
    forall (m :: * -> *) a.
    (Applicative m, Subst a) =>
    m (Abs a) -> m (SubstArg a) -> m a
    `bapp` NamesT (ExceptT (Closure (Abs Type)) m) Term
    NamesT (ExceptT (Closure (Abs Type)) m) (SubstArg Term)
    i)) [(NamesT (ExceptT (Closure (Abs Type)) m) Term,
      NamesT (ExceptT (Closure (Abs Type)) m) (Abs Term))]
    us
                  sys :: [(NamesT (ExceptT (Closure (Abs Type)) m) Term,
      NamesT (ExceptT (Closure (Abs Type)) m) Term)]
    sys = ((NamesT (ExceptT (Closure (Abs Type)) m) Term,
      NamesT (ExceptT (Closure (Abs Type)) m) Term)
     -> (NamesT (ExceptT (Closure (Abs Type)) m) Term,
         NamesT (ExceptT (Closure (Abs Type)) m) Term))
    -> [(NamesT (ExceptT (Closure (Abs Type)) m) Term,
         NamesT (ExceptT (Closure (Abs Type)) m) Term)]
    -> [(NamesT (ExceptT (Closure (Abs Type)) m) Term,
         NamesT (ExceptT (Closure (Abs Type)) m) Term)]
    forall a b. (a -> b) -> [a] -> [b]
    map ((NamesT (ExceptT (Closure (Abs Type)) m) Term
     -> NamesT (ExceptT (Closure (Abs Type)) m) Term)
    -> (NamesT (ExceptT (Closure (Abs Type)) m) Term,
        NamesT (ExceptT (Closure (Abs Type)) m) Term)
    -> (NamesT (ExceptT (Closure (Abs Type)) m) Term,
        NamesT (ExceptT (Closure (Abs Type)) m) Term)
    forall b d a. (b -> d) -> (a, b) -> (a, d)
    mapSnd ((NamesT (ExceptT (Closure (Abs Type)) m) Term
      -> NamesT (ExceptT (Closure (Abs Type)) m) Term)
     -> (NamesT (ExceptT (Closure (Abs Type)) m) Term,
         NamesT (ExceptT (Closure (Abs Type)) m) Term)
     -> (NamesT (ExceptT (Closure (Abs Type)) m) Term,
         NamesT (ExceptT (Closure (Abs Type)) m) Term))
    -> (NamesT (ExceptT (Closure (Abs Type)) m) Term
        -> NamesT (ExceptT (Closure (Abs Type)) m) Term)
    -> (NamesT (ExceptT (Closure (Abs Type)) m) Term,
        NamesT (ExceptT (Closure (Abs Type)) m) Term)
    -> (NamesT (ExceptT (Closure (Abs Type)) m) Term,
        NamesT (ExceptT (Closure (Abs Type)) m) Term)
    forall a b. (a -> b) -> a -> b
    $ String
    -> (NamesT (ExceptT (Closure (Abs Type)) m) Term
        -> NamesT (ExceptT (Closure (Abs Type)) m) Term)
    -> NamesT (ExceptT (Closure (Abs Type)) m) Term
    forall (m :: * -> *).
    Monad m =>
    String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
    ilam String
    "o" ((NamesT (ExceptT (Closure (Abs Type)) m) Term
      -> NamesT (ExceptT (Closure (Abs Type)) m) Term)
     -> NamesT (ExceptT (Closure (Abs Type)) m) Term)
    -> (NamesT (ExceptT (Closure (Abs Type)) m) Term
        -> NamesT (ExceptT (Closure (Abs Type)) m) Term
        -> NamesT (ExceptT (Closure (Abs Type)) m) Term)
    -> NamesT (ExceptT (Closure (Abs Type)) m) Term
    -> NamesT (ExceptT (Closure (Abs Type)) m) Term
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . NamesT (ExceptT (Closure (Abs Type)) m) Term
    -> NamesT (ExceptT (Closure (Abs Type)) m) Term
    -> NamesT (ExceptT (Closure (Abs Type)) m) Term
    forall a b. a -> b -> a
    const) [(NamesT (ExceptT (Closure (Abs Type)) m) Term,
      NamesT (ExceptT (Closure (Abs Type)) m) Term)]
    sys'
              NamesT (ExceptT (Closure (Abs Type)) m) Term
    -> NamesT (ExceptT (Closure (Abs Type)) m) Term
    -> NamesT (ExceptT (Closure (Abs Type)) m) Term
    -> [(NamesT (ExceptT (Closure (Abs Type)) m) Term,
         NamesT (ExceptT (Closure (Abs Type)) m) Term)]
    -> NamesT (ExceptT (Closure (Abs Type)) m) Term
    combine (NamesT (ExceptT (Closure (Abs Type)) m) Term
    l NamesT (ExceptT (Closure (Abs Type)) m) Term
    -> NamesT (ExceptT (Closure (Abs Type)) m) Term
    -> NamesT (ExceptT (Closure (Abs Type)) m) Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <@> NamesT (ExceptT (Closure (Abs Type)) m) Term
    i) (Type -> Term
    forall t a. Type'' t a -> a
    unEl (Type -> Term)
    -> NamesT (ExceptT (Closure (Abs Type)) m) Type
    -> NamesT (ExceptT (Closure (Abs Type)) m) Term
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> NamesT (ExceptT (Closure (Abs Type)) m) (Abs Type)
    -> NamesT (ExceptT (Closure (Abs Type)) m) (SubstArg Type)
    -> NamesT (ExceptT (Closure (Abs Type)) m) Type
    forall (m :: * -> *) a.
    (Applicative m, Subst a) =>
    m (Abs a) -> m (SubstArg a) -> m a
    bapp NamesT (ExceptT (Closure (Abs Type)) m) (Abs Type)
    t NamesT (ExceptT (Closure (Abs Type)) m) Term
    NamesT (ExceptT (Closure (Abs Type)) m) (SubstArg Type)
    i) NamesT (ExceptT (Closure (Abs Type)) m) Term
    forall a. HasCallStack => a
    __IMPOSSIBLE__ [(NamesT (ExceptT (Closure (Abs Type)) m) Term,
      NamesT (ExceptT (Closure (Abs Type)) m) Term)]
    sys NamesT (ExceptT (Closure (Abs Type)) m) Term
    -> NamesT (ExceptT (Closure (Abs Type)) m) Term
    -> NamesT (ExceptT (Closure (Abs Type)) m) Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <..> NamesT (ExceptT (Closure (Abs Type)) m) Term
    o
        combine NamesT (ExceptT (Closure (Abs Type)) m) Term
    l NamesT (ExceptT (Closure (Abs Type)) m) Term
    ty NamesT (ExceptT (Closure (Abs Type)) m) Term
    d [] = NamesT (ExceptT (Closure (Abs Type)) m) Term
    d
        combine NamesT (ExceptT (Closure (Abs Type)) m) Term
    l NamesT (ExceptT (Closure (Abs Type)) m) Term
    ty NamesT (ExceptT (Closure (Abs Type)) m) Term
    d [(NamesT (ExceptT (Closure (Abs Type)) m) Term
    psi,NamesT (ExceptT (Closure (Abs Type)) m) Term
    u)] = NamesT (ExceptT (Closure (Abs Type)) m) Term
    u
        combine NamesT (ExceptT (Closure (Abs Type)) m) Term
    l NamesT (ExceptT (Closure (Abs Type)) m) Term
    ty NamesT (ExceptT (Closure (Abs Type)) m) Term
    d ((NamesT (ExceptT (Closure (Abs Type)) m) Term
    psi,NamesT (ExceptT (Closure (Abs Type)) m) Term
    u):[(NamesT (ExceptT (Closure (Abs Type)) m) Term,
      NamesT (ExceptT (Closure (Abs Type)) m) Term)]
    xs)
                = Term -> NamesT (ExceptT (Closure (Abs Type)) m) Term
    forall a. a -> NamesT (ExceptT (Closure (Abs Type)) m) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Term
    tPOr NamesT (ExceptT (Closure (Abs Type)) m) Term
    -> NamesT (ExceptT (Closure (Abs Type)) m) Term
    -> NamesT (ExceptT (Closure (Abs Type)) m) Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <#> NamesT (ExceptT (Closure (Abs Type)) m) Term
    l NamesT (ExceptT (Closure (Abs Type)) m) Term
    -> NamesT (ExceptT (Closure (Abs Type)) m) Term
    -> NamesT (ExceptT (Closure (Abs Type)) m) Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <@> NamesT (ExceptT (Closure (Abs Type)) m) Term
    psi NamesT (ExceptT (Closure (Abs Type)) m) Term
    -> NamesT (ExceptT (Closure (Abs Type)) m) Term
    -> NamesT (ExceptT (Closure (Abs Type)) m) Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <@> ((NamesT (ExceptT (Closure (Abs Type)) m) Term
     -> NamesT (ExceptT (Closure (Abs Type)) m) Term
     -> NamesT (ExceptT (Closure (Abs Type)) m) Term)
    -> NamesT (ExceptT (Closure (Abs Type)) m) Term
    -> [NamesT (ExceptT (Closure (Abs Type)) m) Term]
    -> NamesT (ExceptT (Closure (Abs Type)) m) Term
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr (\ NamesT (ExceptT (Closure (Abs Type)) m) Term
    x NamesT (ExceptT (Closure (Abs Type)) m) Term
    y -> Term -> NamesT (ExceptT (Closure (Abs Type)) m) Term
    forall a. a -> NamesT (ExceptT (Closure (Abs Type)) m) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Term
    imax NamesT (ExceptT (Closure (Abs Type)) m) Term
    -> NamesT (ExceptT (Closure (Abs Type)) m) Term
    -> NamesT (ExceptT (Closure (Abs Type)) m) Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <@> NamesT (ExceptT (Closure (Abs Type)) m) Term
    x NamesT (ExceptT (Closure (Abs Type)) m) Term
    -> NamesT (ExceptT (Closure (Abs Type)) m) Term
    -> NamesT (ExceptT (Closure (Abs Type)) m) Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <@> NamesT (ExceptT (Closure (Abs Type)) m) Term
    y) (Term -> NamesT (ExceptT (Closure (Abs Type)) m) Term
    forall a. a -> NamesT (ExceptT (Closure (Abs Type)) m) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Term
    iz) (((NamesT (ExceptT (Closure (Abs Type)) m) Term,
      NamesT (ExceptT (Closure (Abs Type)) m) Term)
     -> NamesT (ExceptT (Closure (Abs Type)) m) Term)
    -> [(NamesT (ExceptT (Closure (Abs Type)) m) Term,
         NamesT (ExceptT (Closure (Abs Type)) m) Term)]
    -> [NamesT (ExceptT (Closure (Abs Type)) m) Term]
    forall a b. (a -> b) -> [a] -> [b]
    map (NamesT (ExceptT (Closure (Abs Type)) m) Term,
     NamesT (ExceptT (Closure (Abs Type)) m) Term)
    -> NamesT (ExceptT (Closure (Abs Type)) m) Term
    forall a b. (a, b) -> a
    fst [(NamesT (ExceptT (Closure (Abs Type)) m) Term,
      NamesT (ExceptT (Closure (Abs Type)) m) Term)]
    xs))
                            NamesT (ExceptT (Closure (Abs Type)) m) Term
    -> NamesT (ExceptT (Closure (Abs Type)) m) Term
    -> NamesT (ExceptT (Closure (Abs Type)) m) Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <#> String
    -> (NamesT (ExceptT (Closure (Abs Type)) m) Term
        -> NamesT (ExceptT (Closure (Abs Type)) m) Term)
    -> NamesT (ExceptT (Closure (Abs Type)) m) Term
    forall (m :: * -> *).
    Monad m =>
    String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
    ilam String
    "o" (\ NamesT (ExceptT (Closure (Abs Type)) m) Term
    _ -> NamesT (ExceptT (Closure (Abs Type)) m) Term
    ty) -- the type
                            NamesT (ExceptT (Closure (Abs Type)) m) Term
    -> NamesT (ExceptT (Closure (Abs Type)) m) Term
    -> NamesT (ExceptT (Closure (Abs Type)) m) Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <@> NamesT (ExceptT (Closure (Abs Type)) m) Term
    u NamesT (ExceptT (Closure (Abs Type)) m) Term
    -> NamesT (ExceptT (Closure (Abs Type)) m) Term
    -> NamesT (ExceptT (Closure (Abs Type)) m) Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <@> (NamesT (ExceptT (Closure (Abs Type)) m) Term
    -> NamesT (ExceptT (Closure (Abs Type)) m) Term
    -> NamesT (ExceptT (Closure (Abs Type)) m) Term
    -> [(NamesT (ExceptT (Closure (Abs Type)) m) Term,
         NamesT (ExceptT (Closure (Abs Type)) m) Term)]
    -> NamesT (ExceptT (Closure (Abs Type)) m) Term
    combine NamesT (ExceptT (Closure (Abs Type)) m) Term
    l NamesT (ExceptT (Closure (Abs Type)) m) Term
    ty NamesT (ExceptT (Closure (Abs Type)) m) Term
    d [(NamesT (ExceptT (Closure (Abs Type)) m) Term,
      NamesT (ExceptT (Closure (Abs Type)) m) Term)]
    xs)

        gTransp :: Maybe (LM m Term) -> LM m (Abs Type) -> [(LM m Term,LM m (Abs Term))] -> LM m Term -> LM m Term -> LM m Term
        gTransp (Just NamesT (ExceptT (Closure (Abs Type)) m) Term
    l) NamesT (ExceptT (Closure (Abs Type)) m) (Abs Type)
    t [(NamesT (ExceptT (Closure (Abs Type)) m) Term,
      NamesT (ExceptT (Closure (Abs Type)) m) (Abs Term))]
    u NamesT (ExceptT (Closure (Abs Type)) m) Term
    phi NamesT (ExceptT (Closure (Abs Type)) m) Term
    a
         | Bool
    flag = do
          t' <- NamesT (ExceptT (Closure (Abs Type)) m) (Abs Type)
    t
          us' <- mapM snd u
          case ( 0 `freeIn` (raise 1 t' `lazyAbsApp` var 0)
               , 0 `freeIn` map (\ Abs Term
    u -> Nat -> Abs Term -> Abs Term
    forall a. Subst a => Nat -> a -> a
    raise Nat
    1 Abs Term
    u Abs Term -> SubstArg Term -> Term
    forall a. Subst a => Abs a -> SubstArg a -> a
    `lazyAbsApp` Nat -> Term
    var Nat
    0) us'
               ) of
            (Bool
    False,Bool
    False) -> NamesT (ExceptT (Closure (Abs Type)) m) Term
    a
            (Bool
    False,Bool
    True)  -> NamesT (ExceptT (Closure (Abs Type)) m) Term
    -> NamesT (ExceptT (Closure (Abs Type)) m) (Abs Type)
    -> [(NamesT (ExceptT (Closure (Abs Type)) m) Term,
         NamesT (ExceptT (Closure (Abs Type)) m) (Abs Term))]
    -> NamesT (ExceptT (Closure (Abs Type)) m) Term
    -> NamesT (ExceptT (Closure (Abs Type)) m) Term
    -> NamesT (ExceptT (Closure (Abs Type)) m) Term
    doGTransp NamesT (ExceptT (Closure (Abs Type)) m) Term
    l NamesT (ExceptT (Closure (Abs Type)) m) (Abs Type)
    t [(NamesT (ExceptT (Closure (Abs Type)) m) Term,
      NamesT (ExceptT (Closure (Abs Type)) m) (Abs Term))]
    u NamesT (ExceptT (Closure (Abs Type)) m) Term
    phi NamesT (ExceptT (Closure (Abs Type)) m) Term
    a -- TODO? optimize to "hcomp (l <@> io) (bapp t io) ((phi,NoAbs a):u) a" ?
            (Bool
    True,Bool
    _) -> NamesT (ExceptT (Closure (Abs Type)) m) Term
    -> NamesT (ExceptT (Closure (Abs Type)) m) (Abs Type)
    -> [(NamesT (ExceptT (Closure (Abs Type)) m) Term,
         NamesT (ExceptT (Closure (Abs Type)) m) (Abs Term))]
    -> NamesT (ExceptT (Closure (Abs Type)) m) Term
    -> NamesT (ExceptT (Closure (Abs Type)) m) Term
    -> NamesT (ExceptT (Closure (Abs Type)) m) Term
    doGTransp NamesT (ExceptT (Closure (Abs Type)) m) Term
    l NamesT (ExceptT (Closure (Abs Type)) m) (Abs Type)
    t [(NamesT (ExceptT (Closure (Abs Type)) m) Term,
      NamesT (ExceptT (Closure (Abs Type)) m) (Abs Term))]
    u NamesT (ExceptT (Closure (Abs Type)) m) Term
    phi NamesT (ExceptT (Closure (Abs Type)) m) Term
    a
         | Bool
    otherwise = NamesT (ExceptT (Closure (Abs Type)) m) Term
    -> NamesT (ExceptT (Closure (Abs Type)) m) (Abs Type)
    -> [(NamesT (ExceptT (Closure (Abs Type)) m) Term,
         NamesT (ExceptT (Closure (Abs Type)) m) (Abs Term))]
    -> NamesT (ExceptT (Closure (Abs Type)) m) Term
    -> NamesT (ExceptT (Closure (Abs Type)) m) Term
    -> NamesT (ExceptT (Closure (Abs Type)) m) Term
    doGTransp NamesT (ExceptT (Closure (Abs Type)) m) Term
    l NamesT (ExceptT (Closure (Abs Type)) m) (Abs Type)
    t [(NamesT (ExceptT (Closure (Abs Type)) m) Term,
      NamesT (ExceptT (Closure (Abs Type)) m) (Abs Term))]
    u NamesT (ExceptT (Closure (Abs Type)) m) Term
    phi NamesT (ExceptT (Closure (Abs Type)) m) Term
    a

        gTransp Maybe (NamesT (ExceptT (Closure (Abs Type)) m) Term)
    Nothing NamesT (ExceptT (Closure (Abs Type)) m) (Abs Type)
    t [(NamesT (ExceptT (Closure (Abs Type)) m) Term,
      NamesT (ExceptT (Closure (Abs Type)) m) (Abs Term))]
    sys NamesT (ExceptT (Closure (Abs Type)) m) Term
    phi NamesT (ExceptT (Closure (Abs Type)) m) Term
    a = do
          let ([NamesT (ExceptT (Closure (Abs Type)) m) Term]
    psis,[NamesT (ExceptT (Closure (Abs Type)) m) (Abs Term)]
    us) = [(NamesT (ExceptT (Closure (Abs Type)) m) Term,
      NamesT (ExceptT (Closure (Abs Type)) m) (Abs Term))]
    -> ([NamesT (ExceptT (Closure (Abs Type)) m) Term],
        [NamesT (ExceptT (Closure (Abs Type)) m) (Abs Term)])
    forall a b. [(a, b)] -> ([a], [b])
    unzip [(NamesT (ExceptT (Closure (Abs Type)) m) Term,
      NamesT (ExceptT (Closure (Abs Type)) m) (Abs Term))]
    sys
          -- Γ ⊢ i.Ξ
          xi <- (Abs Telescope
    -> NamesT
         (ExceptT (Closure (Abs Type)) m)
         (NamesT (ExceptT (Closure (Abs Type)) m) (Abs Telescope))
    forall (m :: * -> *) a.
    (Monad m, Subst a) =>
    a -> NamesT m (NamesT m a)
    open (Abs Telescope
     -> NamesT
          (ExceptT (Closure (Abs Type)) m)
          (NamesT (ExceptT (Closure (Abs Type)) m) (Abs Telescope)))
    -> NamesT (ExceptT (Closure (Abs Type)) m) (Abs Telescope)
    -> NamesT
         (ExceptT (Closure (Abs Type)) m)
         (NamesT (ExceptT (Closure (Abs Type)) m) (Abs Telescope))
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<<) (NamesT (ExceptT (Closure (Abs Type)) m) (Abs Telescope)
     -> NamesT
          (ExceptT (Closure (Abs Type)) m)
          (NamesT (ExceptT (Closure (Abs Type)) m) (Abs Telescope)))
    -> NamesT (ExceptT (Closure (Abs Type)) m) (Abs Telescope)
    -> NamesT
         (ExceptT (Closure (Abs Type)) m)
         (NamesT (ExceptT (Closure (Abs Type)) m) (Abs Telescope))
    forall a b. (a -> b) -> a -> b
    $ do
            String
    -> ((forall b.
         (Subst b, DeBruijn b) =>
         NamesT (ExceptT (Closure (Abs Type)) m) b)
        -> NamesT (ExceptT (Closure (Abs Type)) m) Telescope)
    -> NamesT (ExceptT (Closure (Abs Type)) m) (Abs Telescope)
    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 (ExceptT (Closure (Abs Type)) m) b)
      -> NamesT (ExceptT (Closure (Abs Type)) m) Telescope)
     -> NamesT (ExceptT (Closure (Abs Type)) m) (Abs Telescope))
    -> ((forall b.
         (Subst b, DeBruijn b) =>
         NamesT (ExceptT (Closure (Abs Type)) m) b)
        -> NamesT (ExceptT (Closure (Abs Type)) m) Telescope)
    -> NamesT (ExceptT (Closure (Abs Type)) m) (Abs Telescope)
    forall a b. (a -> b) -> a -> b
    $ \ forall b.
    (Subst b, DeBruijn b) =>
    NamesT (ExceptT (Closure (Abs Type)) m) b
    i -> do
              TelV xi _ <- (ExceptT (Closure (Abs Type)) m (TelV Type)
    -> NamesT (ExceptT (Closure (Abs Type)) m) (TelV Type)
    forall (m :: * -> *) a. Monad m => m a -> NamesT m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (ExceptT (Closure (Abs Type)) m (TelV Type)
     -> NamesT (ExceptT (Closure (Abs Type)) m) (TelV Type))
    -> (Type -> ExceptT (Closure (Abs Type)) m (TelV Type))
    -> Type
    -> NamesT (ExceptT (Closure (Abs Type)) m) (TelV Type)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Type -> ExceptT (Closure (Abs Type)) m (TelV Type)
    forall (m :: * -> *).
    (MonadReduce m, MonadAddContext m) =>
    Type -> m (TelV Type)
    telView (Type -> NamesT (ExceptT (Closure (Abs Type)) m) (TelV Type))
    -> NamesT (ExceptT (Closure (Abs Type)) m) Type
    -> NamesT (ExceptT (Closure (Abs Type)) m) (TelV Type)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<<) (NamesT (ExceptT (Closure (Abs Type)) m) Type
     -> NamesT (ExceptT (Closure (Abs Type)) m) (TelV Type))
    -> NamesT (ExceptT (Closure (Abs Type)) m) Type
    -> NamesT (ExceptT (Closure (Abs Type)) m) (TelV Type)
    forall a b. (a -> b) -> a -> b
    $ NamesT (ExceptT (Closure (Abs Type)) m) (Abs Type)
    t NamesT (ExceptT (Closure (Abs Type)) m) (Abs Type)
    -> NamesT (ExceptT (Closure (Abs Type)) m) (SubstArg Type)
    -> NamesT (ExceptT (Closure (Abs Type)) m) Type
    forall (m :: * -> *) a.
    (Applicative m, Subst a) =>
    m (Abs a) -> m (SubstArg a) -> m a
    `bapp` NamesT (ExceptT (Closure (Abs Type)) m) Term
    NamesT (ExceptT (Closure (Abs Type)) m) (SubstArg Type)
    forall b.
    (Subst b, DeBruijn b) =>
    NamesT (ExceptT (Closure (Abs Type)) m) b
    i
              return xi
          argnames <- do
            teleArgNames . unAbs <$> xi
          glamN argnames $ \ NamesT (ExceptT (Closure (Abs Type)) m) [Arg Term]
    xi_args -> do
            b' <- String
    -> ((forall b.
         (Subst b, DeBruijn b) =>
         NamesT (ExceptT (Closure (Abs Type)) m) b)
        -> NamesT (ExceptT (Closure (Abs Type)) m) Type)
    -> NamesT (ExceptT (Closure (Abs Type)) m) (Abs 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 (ExceptT (Closure (Abs Type)) m) b)
      -> NamesT (ExceptT (Closure (Abs Type)) m) Type)
     -> NamesT (ExceptT (Closure (Abs Type)) m) (Abs Type))
    -> ((forall b.
         (Subst b, DeBruijn b) =>
         NamesT (ExceptT (Closure (Abs Type)) m) b)
        -> NamesT (ExceptT (Closure (Abs Type)) m) Type)
    -> NamesT (ExceptT (Closure (Abs Type)) m) (Abs Type)
    forall a b. (a -> b) -> a -> b
    $ \ forall b.
    (Subst b, DeBruijn b) =>
    NamesT (ExceptT (Closure (Abs Type)) m) b
    i -> do
              ti <- NamesT (ExceptT (Closure (Abs Type)) m) (Abs Type)
    t NamesT (ExceptT (Closure (Abs Type)) m) (Abs Type)
    -> NamesT (ExceptT (Closure (Abs Type)) m) (SubstArg Type)
    -> NamesT (ExceptT (Closure (Abs Type)) m) Type
    forall (m :: * -> *) a.
    (Applicative m, Subst a) =>
    m (Abs a) -> m (SubstArg a) -> m a
    `bapp` NamesT (ExceptT (Closure (Abs Type)) m) Term
    NamesT (ExceptT (Closure (Abs Type)) m) (SubstArg Type)
    forall b.
    (Subst b, DeBruijn b) =>
    NamesT (ExceptT (Closure (Abs Type)) m) b
    i
              xin <- bind "i" $ \ forall b.
    (Subst b, DeBruijn b) =>
    NamesT (ExceptT (Closure (Abs Type)) m) b
    i -> NamesT (ExceptT (Closure (Abs Type)) m) (Abs Telescope)
    xi NamesT (ExceptT (Closure (Abs Type)) m) (Abs Telescope)
    -> NamesT (ExceptT (Closure (Abs Type)) m) (SubstArg Telescope)
    -> NamesT (ExceptT (Closure (Abs Type)) m) Telescope
    forall (m :: * -> *) a.
    (Applicative m, Subst a) =>
    m (Abs a) -> m (SubstArg a) -> m a
    `bapp` (Term -> NamesT (ExceptT (Closure (Abs Type)) m) Term
    forall a. a -> NamesT (ExceptT (Closure (Abs Type)) m) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Term
    ineg NamesT (ExceptT (Closure (Abs Type)) m) Term
    -> NamesT (ExceptT (Closure (Abs Type)) m) Term
    -> NamesT (ExceptT (Closure (Abs Type)) m) Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <@> NamesT (ExceptT (Closure (Abs Type)) m) Term
    forall b.
    (Subst b, DeBruijn b) =>
    NamesT (ExceptT (Closure (Abs Type)) m) b
    i)
              xi_args <- xi_args
              ni <- pure ineg <@> i
              phi <- phi
              lift $ piApplyM ti =<< trFillTel' flag xin phi xi_args ni
            usxi <- forM us $ \ NamesT (ExceptT (Closure (Abs Type)) m) (Abs Term)
    u -> String
    -> ((forall b.
         (Subst b, DeBruijn b) =>
         NamesT (ExceptT (Closure (Abs Type)) m) b)
        -> NamesT (ExceptT (Closure (Abs Type)) m) Term)
    -> NamesT (ExceptT (Closure (Abs Type)) m) (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 (ExceptT (Closure (Abs Type)) m) b)
      -> NamesT (ExceptT (Closure (Abs Type)) m) Term)
     -> NamesT (ExceptT (Closure (Abs Type)) m) (Abs Term))
    -> ((forall b.
         (Subst b, DeBruijn b) =>
         NamesT (ExceptT (Closure (Abs Type)) m) b)
        -> NamesT (ExceptT (Closure (Abs Type)) m) Term)
    -> NamesT (ExceptT (Closure (Abs Type)) m) (Abs Term)
    forall a b. (a -> b) -> a -> b
    $ \ forall b.
    (Subst b, DeBruijn b) =>
    NamesT (ExceptT (Closure (Abs Type)) m) b
    i -> do
              ui <- NamesT (ExceptT (Closure (Abs Type)) m) (Abs Term)
    u NamesT (ExceptT (Closure (Abs Type)) m) (Abs Term)
    -> NamesT (ExceptT (Closure (Abs Type)) m) (SubstArg Term)
    -> NamesT (ExceptT (Closure (Abs Type)) m) Term
    forall (m :: * -> *) a.
    (Applicative m, Subst a) =>
    m (Abs a) -> m (SubstArg a) -> m a
    `bapp` NamesT (ExceptT (Closure (Abs Type)) m) Term
    NamesT (ExceptT (Closure (Abs Type)) m) (SubstArg Term)
    forall b.
    (Subst b, DeBruijn b) =>
    NamesT (ExceptT (Closure (Abs Type)) m) b
    i
              xin <- bind "i" $ \ forall b.
    (Subst b, DeBruijn b) =>
    NamesT (ExceptT (Closure (Abs Type)) m) b
    i -> NamesT (ExceptT (Closure (Abs Type)) m) (Abs Telescope)
    xi NamesT (ExceptT (Closure (Abs Type)) m) (Abs Telescope)
    -> NamesT (ExceptT (Closure (Abs Type)) m) (SubstArg Telescope)
    -> NamesT (ExceptT (Closure (Abs Type)) m) Telescope
    forall (m :: * -> *) a.
    (Applicative m, Subst a) =>
    m (Abs a) -> m (SubstArg a) -> m a
    `bapp` (Term -> NamesT (ExceptT (Closure (Abs Type)) m) Term
    forall a. a -> NamesT (ExceptT (Closure (Abs Type)) m) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Term
    ineg NamesT (ExceptT (Closure (Abs Type)) m) Term
    -> NamesT (ExceptT (Closure (Abs Type)) m) Term
    -> NamesT (ExceptT (Closure (Abs Type)) m) Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <@> NamesT (ExceptT (Closure (Abs Type)) m) Term
    forall b.
    (Subst b, DeBruijn b) =>
    NamesT (ExceptT (Closure (Abs Type)) m) b
    i)
              xi_args <- xi_args
              ni <- pure ineg <@> i
              phi <- phi
              lift $ apply ui <$> trFillTel' flag xin phi xi_args ni
            axi <- do
              a <- a
              xif <- bind "i" $ \ forall b.
    (Subst b, DeBruijn b) =>
    NamesT (ExceptT (Closure (Abs Type)) m) b
    i -> NamesT (ExceptT (Closure (Abs Type)) m) (Abs Telescope)
    xi NamesT (ExceptT (Closure (Abs Type)) m) (Abs Telescope)
    -> NamesT (ExceptT (Closure (Abs Type)) m) (SubstArg Telescope)
    -> NamesT (ExceptT (Closure (Abs Type)) m) Telescope
    forall (m :: * -> *) a.
    (Applicative m, Subst a) =>
    m (Abs a) -> m (SubstArg a) -> m a
    `bapp` (Term -> NamesT (ExceptT (Closure (Abs Type)) m) Term
    forall a. a -> NamesT (ExceptT (Closure (Abs Type)) m) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Term
    ineg NamesT (ExceptT (Closure (Abs Type)) m) Term
    -> NamesT (ExceptT (Closure (Abs Type)) m) Term
    -> NamesT (ExceptT (Closure (Abs Type)) m) Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <@> NamesT (ExceptT (Closure (Abs Type)) m) Term
    forall b.
    (Subst b, DeBruijn b) =>
    NamesT (ExceptT (Closure (Abs Type)) m) b
    i)
              phi <- phi
              xi_args <- xi_args
              lift $ apply a <$> transpTel' flag xif phi xi_args
            s <- reduce $ getSort (absBody b')
            reportSDoc "cubical.transp" 20 $ pretty (raise 1 b' `lazyAbsApp` var 0)
            let noTranspSort = if Nat
    0 Nat -> Type -> Bool
    forall a. Free a => Nat -> a -> Bool
    `freeIn` (Nat -> Abs Type -> Abs Type
    forall a. Subst a => Nat -> a -> a
    raise Nat
    1 Abs Type
    b' Abs Type -> SubstArg Type -> Type
    forall a. Subst a => Abs a -> SubstArg a -> a
    `lazyAbsApp` Nat -> Term
    var Nat
    0) Bool -> Bool -> Bool
    || Nat
    0 Nat -> [Term] -> Bool
    forall a. Free a => Nat -> a -> Bool
    `freeIn` ((Abs Term -> Term) -> [Abs Term] -> [Term]
    forall a b. (a -> b) -> [a] -> [b]
    map (Abs Term -> SubstArg Term -> Term
    forall a. Subst a => Abs a -> SubstArg a -> a
    `lazyAbsApp` Nat -> Term
    var Nat
    0) (Nat -> [Abs Term] -> [Abs Term]
    forall a. Subst a => Nat -> a -> a
    raise Nat
    1 [Abs Term]
    usxi))
                  then Abs Type -> NamesT (ExceptT (Closure (Abs Type)) m) Term
    forall {t :: (* -> *) -> * -> *} {m :: * -> *} {a} {b}.
    (MonadDebug (t m), PrettyTCM a, MonadTrans t,
     MonadError (Closure (Abs a)) m, MonadTCEnv (t m),
     ReadTCState (t m)) =>
    Abs a -> t m b
    noTranspError Abs Type
    b'
                  else Term -> NamesT (ExceptT (Closure (Abs Type)) m) Term
    forall a. a -> NamesT (ExceptT (Closure (Abs Type)) m) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Term
    axi

            case s of
              Univ Univ
    UType Level' Term
    l -> do
                l <- Term
    -> NamesT
         (ExceptT (Closure (Abs Type)) m)
         (NamesT (ExceptT (Closure (Abs Type)) m) Term)
    forall (m :: * -> *) a.
    (Monad m, Subst a) =>
    a -> NamesT m (NamesT m a)
    open (Term
     -> NamesT
          (ExceptT (Closure (Abs Type)) m)
          (NamesT (ExceptT (Closure (Abs Type)) m) Term))
    -> Term
    -> NamesT
         (ExceptT (Closure (Abs Type)) m)
         (NamesT (ExceptT (Closure (Abs Type)) m) Term)
    forall a b. (a -> b) -> a -> b
    $ Term -> Term
    lam_i (Term -> Term) -> Term -> Term
    forall a b. (a -> b) -> a -> b
    $ Level' Term -> Term
    Level Level' Term
    l
                b' <- open b'
                axi <- open axi
                usxi <- mapM open usxi
                gTransp (Just l) b' (zip psis usxi) phi axi
              Univ Univ
    _ Level' Term
    _     -> NamesT (ExceptT (Closure (Abs Type)) m) Term
    noTranspSort
              Inf Univ
    _ Integer
    _      -> NamesT (ExceptT (Closure (Abs Type)) m) Term
    noTranspSort
              Sort
    IntervalUniv -> NamesT (ExceptT (Closure (Abs Type)) m) Term
    noTranspSort
              Sort
    LevelUniv    -> NamesT (ExceptT (Closure (Abs Type)) m) Term
    noTranspSort
              Sort
    LockUniv     -> NamesT (ExceptT (Closure (Abs Type)) m) Term
    noTranspSort
              Sort
    SizeUniv     -> NamesT (ExceptT (Closure (Abs Type)) m) Term
    noTranspSort
              PiSort{}     -> Abs Type -> NamesT (ExceptT (Closure (Abs Type)) m) Term
    forall {t :: (* -> *) -> * -> *} {m :: * -> *} {a} {b}.
    (MonadDebug (t m), PrettyTCM a, MonadTrans t,
     MonadError (Closure (Abs a)) m, MonadTCEnv (t m),
     ReadTCState (t m)) =>
    Abs a -> t m b
    noTranspError Abs Type
    b'
              FunSort{}    -> Abs Type -> NamesT (ExceptT (Closure (Abs Type)) m) Term
    forall {t :: (* -> *) -> * -> *} {m :: * -> *} {a} {b}.
    (MonadDebug (t m), PrettyTCM a, MonadTrans t,
     MonadError (Closure (Abs a)) m, MonadTCEnv (t m),
     ReadTCState (t m)) =>
    Abs a -> t m b
    noTranspError Abs Type
    b'
              UnivSort{}   -> Abs Type -> NamesT (ExceptT (Closure (Abs Type)) m) Term
    forall {t :: (* -> *) -> * -> *} {m :: * -> *} {a} {b}.
    (MonadDebug (t m), PrettyTCM a, MonadTrans t,
     MonadError (Closure (Abs a)) m, MonadTCEnv (t m),
     ReadTCState (t m)) =>
    Abs a -> t m b
    noTranspError Abs Type
    b'
              MetaS{}      -> Abs Type -> NamesT (ExceptT (Closure (Abs Type)) m) Term
    forall {t :: (* -> *) -> * -> *} {m :: * -> *} {a} {b}.
    (MonadDebug (t m), PrettyTCM a, MonadTrans t,
     MonadError (Closure (Abs a)) m, MonadTCEnv (t m),
     ReadTCState (t m)) =>
    Abs a -> t m b
    noTranspError Abs Type
    b'
              DefS{}       -> Abs Type -> NamesT (ExceptT (Closure (Abs Type)) m) Term
    forall {t :: (* -> *) -> * -> *} {m :: * -> *} {a} {b}.
    (MonadDebug (t m), PrettyTCM a, MonadTrans t,
     MonadError (Closure (Abs a)) m, MonadTCEnv (t m),
     ReadTCState (t m)) =>
    Abs a -> t m b
    noTranspError Abs Type
    b'
              DummyS{}     -> Abs Type -> NamesT (ExceptT (Closure (Abs Type)) m) Term
    forall {t :: (* -> *) -> * -> *} {m :: * -> *} {a} {b}.
    (MonadDebug (t m), PrettyTCM a, MonadTrans t,
     MonadError (Closure (Abs a)) m, MonadTCEnv (t m),
     ReadTCState (t m)) =>
    Abs a -> t m b
    noTranspError Abs Type
    b'

        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"
        go :: Telescope -> [[(Term,Term)]] -> Term -> Args -> ExceptT (Closure (Abs Type)) m Args
        go Telescope
    EmptyTel            [] Term
    _  []       = [Arg Term] -> ExceptT (Closure (Abs Type)) m [Arg Term]
    forall a. a -> ExceptT (Closure (Abs Type)) m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return []
        go (ExtendTel Dom' Term Type
    t Abs Telescope
    delta) ([(Term, Term)]
    u:[[(Term, Term)]]
    us) Term
    phi (Arg Term
    a:[Arg Term]
    args) = do
          -- Γ,i ⊢ t
          -- Γ,i ⊢ (x : t). delta
          -- Γ ⊢ a : t[0]
          s <- Sort -> ExceptT (Closure (Abs Type)) m Sort
    forall a (m :: * -> *). (Reduce a, MonadReduce m) => a -> m a
    reduce (Sort -> ExceptT (Closure (Abs Type)) m Sort)
    -> Sort -> ExceptT (Closure (Abs Type)) m Sort
    forall a b. (a -> b) -> a -> b
    $ Dom' Term Type -> Sort
    forall a. LensSort a => a -> Sort
    getSort Dom' Term Type
    t
          -- Γ ⊢ b : t[1]    Γ, i ⊢ bf : t[i]
          (b,bf) <- runNamesT [] $ do
            let b' = String -> Type -> Abs Type
    forall a. String -> a -> Abs a
    Abs String
    "i" (Type -> Abs Type) -> Type -> Abs Type
    forall a b. (a -> b) -> a -> b
    $ Dom' Term Type -> Type
    forall t e. Dom' t e -> e
    unDom Dom' Term Type
    t
            l <- case s of
              Univ Univ
    UType Level' Term
    l -> NamesT (ExceptT (Closure (Abs Type)) m) Term
    -> Maybe (NamesT (ExceptT (Closure (Abs Type)) m) Term)
    forall a. a -> Maybe a
    Just (NamesT (ExceptT (Closure (Abs Type)) m) Term
     -> Maybe (NamesT (ExceptT (Closure (Abs Type)) m) Term))
    -> NamesT
         (ExceptT (Closure (Abs Type)) m)
         (NamesT (ExceptT (Closure (Abs Type)) m) Term)
    -> NamesT
         (ExceptT (Closure (Abs Type)) m)
         (Maybe (NamesT (ExceptT (Closure (Abs Type)) m) Term))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Term
    -> NamesT
         (ExceptT (Closure (Abs Type)) m)
         (NamesT (ExceptT (Closure (Abs Type)) m) Term)
    forall (m :: * -> *) a.
    (Monad m, Subst a) =>
    a -> NamesT m (NamesT m a)
    open (Term -> Term
    lam_i (Level' Term -> Term
    Level Level' Term
    l))
              Univ Univ
    USSet Level' Term
    _ -> Maybe (NamesT (ExceptT (Closure (Abs Type)) m) Term)
    -> NamesT
         (ExceptT (Closure (Abs Type)) m)
         (Maybe (NamesT (ExceptT (Closure (Abs Type)) m) Term))
    forall a. a -> NamesT (ExceptT (Closure (Abs Type)) m) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe (NamesT (ExceptT (Closure (Abs Type)) m) Term)
    forall a. Maybe a
    Nothing
              Univ Univ
    UProp Level' Term
    _ -> Abs Type
    -> NamesT
         (ExceptT (Closure (Abs Type)) m)
         (Maybe (NamesT (ExceptT (Closure (Abs Type)) m) Term))
    forall {t :: (* -> *) -> * -> *} {m :: * -> *} {a} {b}.
    (MonadDebug (t m), PrettyTCM a, MonadTrans t,
     MonadError (Closure (Abs a)) m, MonadTCEnv (t m),
     ReadTCState (t m)) =>
    Abs a -> t m b
    noTranspError Abs Type
    b'  -- Issue #6060
              Inf  Univ
    UType Integer
    _ -> Maybe (NamesT (ExceptT (Closure (Abs Type)) m) Term)
    -> NamesT
         (ExceptT (Closure (Abs Type)) m)
         (Maybe (NamesT (ExceptT (Closure (Abs Type)) m) Term))
    forall a. a -> NamesT (ExceptT (Closure (Abs Type)) m) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe (NamesT (ExceptT (Closure (Abs Type)) m) Term)
    forall a. Maybe a
    Nothing
              Inf  Univ
    USSet Integer
    _ -> Maybe (NamesT (ExceptT (Closure (Abs Type)) m) Term)
    -> NamesT
         (ExceptT (Closure (Abs Type)) m)
         (Maybe (NamesT (ExceptT (Closure (Abs Type)) m) Term))
    forall a. a -> NamesT (ExceptT (Closure (Abs Type)) m) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe (NamesT (ExceptT (Closure (Abs Type)) m) Term)
    forall a. Maybe a
    Nothing
              Inf  Univ
    UProp Integer
    _ -> Abs Type
    -> NamesT
         (ExceptT (Closure (Abs Type)) m)
         (Maybe (NamesT (ExceptT (Closure (Abs Type)) m) Term))
    forall {t :: (* -> *) -> * -> *} {m :: * -> *} {a} {b}.
    (MonadDebug (t m), PrettyTCM a, MonadTrans t,
     MonadError (Closure (Abs a)) m, MonadTCEnv (t m),
     ReadTCState (t m)) =>
    Abs a -> t m b
    noTranspError Abs Type
    b'  -- Issue #7535
              Sort
    IntervalUniv -> Maybe (NamesT (ExceptT (Closure (Abs Type)) m) Term)
    -> NamesT
         (ExceptT (Closure (Abs Type)) m)
         (Maybe (NamesT (ExceptT (Closure (Abs Type)) m) Term))
    forall a. a -> NamesT (ExceptT (Closure (Abs Type)) m) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe (NamesT (ExceptT (Closure (Abs Type)) m) Term)
    forall a. Maybe a
    Nothing
              Sort
    LevelUniv    -> Maybe (NamesT (ExceptT (Closure (Abs Type)) m) Term)
    -> NamesT
         (ExceptT (Closure (Abs Type)) m)
         (Maybe (NamesT (ExceptT (Closure (Abs Type)) m) Term))
    forall a. a -> NamesT (ExceptT (Closure (Abs Type)) m) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe (NamesT (ExceptT (Closure (Abs Type)) m) Term)
    forall a. Maybe a
    Nothing
              Sort
    LockUniv     -> Maybe (NamesT (ExceptT (Closure (Abs Type)) m) Term)
    -> NamesT
         (ExceptT (Closure (Abs Type)) m)
         (Maybe (NamesT (ExceptT (Closure (Abs Type)) m) Term))
    forall a. a -> NamesT (ExceptT (Closure (Abs Type)) m) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe (NamesT (ExceptT (Closure (Abs Type)) m) Term)
    forall a. Maybe a
    Nothing
              Sort
    SizeUniv     -> Maybe (NamesT (ExceptT (Closure (Abs Type)) m) Term)
    -> NamesT
         (ExceptT (Closure (Abs Type)) m)
         (Maybe (NamesT (ExceptT (Closure (Abs Type)) m) Term))
    forall a. a -> NamesT (ExceptT (Closure (Abs Type)) m) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe (NamesT (ExceptT (Closure (Abs Type)) m) Term)
    forall a. Maybe a
    Nothing
              PiSort{}     -> Abs Type
    -> NamesT
         (ExceptT (Closure (Abs Type)) m)
         (Maybe (NamesT (ExceptT (Closure (Abs Type)) m) Term))
    forall {t :: (* -> *) -> * -> *} {m :: * -> *} {a} {b}.
    (MonadDebug (t m), PrettyTCM a, MonadTrans t,
     MonadError (Closure (Abs a)) m, MonadTCEnv (t m),
     ReadTCState (t m)) =>
    Abs a -> t m b
    noTranspError Abs Type
    b'
              FunSort{}    -> Abs Type
    -> NamesT
         (ExceptT (Closure (Abs Type)) m)
         (Maybe (NamesT (ExceptT (Closure (Abs Type)) m) Term))
    forall {t :: (* -> *) -> * -> *} {m :: * -> *} {a} {b}.
    (MonadDebug (t m), PrettyTCM a, MonadTrans t,
     MonadError (Closure (Abs a)) m, MonadTCEnv (t m),
     ReadTCState (t m)) =>
    Abs a -> t m b
    noTranspError Abs Type
    b'
              UnivSort{}   -> Abs Type
    -> NamesT
         (ExceptT (Closure (Abs Type)) m)
         (Maybe (NamesT (ExceptT (Closure (Abs Type)) m) Term))
    forall {t :: (* -> *) -> * -> *} {m :: * -> *} {a} {b}.
    (MonadDebug (t m), PrettyTCM a, MonadTrans t,
     MonadError (Closure (Abs a)) m, MonadTCEnv (t m),
     ReadTCState (t m)) =>
    Abs a -> t m b
    noTranspError Abs Type
    b'
              MetaS{}      -> Abs Type
    -> NamesT
         (ExceptT (Closure (Abs Type)) m)
         (Maybe (NamesT (ExceptT (Closure (Abs Type)) m) Term))
    forall {t :: (* -> *) -> * -> *} {m :: * -> *} {a} {b}.
    (MonadDebug (t m), PrettyTCM a, MonadTrans t,
     MonadError (Closure (Abs a)) m, MonadTCEnv (t m),
     ReadTCState (t m)) =>
    Abs a -> t m b
    noTranspError Abs Type
    b'
              DefS{}       -> Abs Type
    -> NamesT
         (ExceptT (Closure (Abs Type)) m)
         (Maybe (NamesT (ExceptT (Closure (Abs Type)) m) Term))
    forall {t :: (* -> *) -> * -> *} {m :: * -> *} {a} {b}.
    (MonadDebug (t m), PrettyTCM a, MonadTrans t,
     MonadError (Closure (Abs a)) m, MonadTCEnv (t m),
     ReadTCState (t m)) =>
    Abs a -> t m b
    noTranspError Abs Type
    b'
              DummyS{}     -> Abs Type
    -> NamesT
         (ExceptT (Closure (Abs Type)) m)
         (Maybe (NamesT (ExceptT (Closure (Abs Type)) m) Term))
    forall {t :: (* -> *) -> * -> *} {m :: * -> *} {a} {b}.
    (MonadDebug (t m), PrettyTCM a, MonadTrans t,
     MonadError (Closure (Abs a)) m, MonadTCEnv (t m),
     ReadTCState (t m)) =>
    Abs a -> t m b
    noTranspError Abs Type
    b'
            t <- open b'
            u <- forM u $ \ (Term
    psi,Term
    upsi) -> do
                  (,) (NamesT (ExceptT (Closure (Abs Type)) m) Term
     -> NamesT (ExceptT (Closure (Abs Type)) m) (Abs Term)
     -> (NamesT (ExceptT (Closure (Abs Type)) m) Term,
         NamesT (ExceptT (Closure (Abs Type)) m) (Abs Term)))
    -> NamesT
         (ExceptT (Closure (Abs Type)) m)
         (NamesT (ExceptT (Closure (Abs Type)) m) Term)
    -> NamesT
         (ExceptT (Closure (Abs Type)) m)
         (NamesT (ExceptT (Closure (Abs Type)) m) (Abs Term)
          -> (NamesT (ExceptT (Closure (Abs Type)) m) Term,
              NamesT (ExceptT (Closure (Abs Type)) m) (Abs Term)))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Term
    -> NamesT
         (ExceptT (Closure (Abs Type)) m)
         (NamesT (ExceptT (Closure (Abs Type)) m) Term)
    forall (m :: * -> *) a.
    (Monad m, Subst a) =>
    a -> NamesT m (NamesT m a)
    open Term
    psi NamesT
      (ExceptT (Closure (Abs Type)) m)
      (NamesT (ExceptT (Closure (Abs Type)) m) (Abs Term)
       -> (NamesT (ExceptT (Closure (Abs Type)) m) Term,
           NamesT (ExceptT (Closure (Abs Type)) m) (Abs Term)))
    -> NamesT
         (ExceptT (Closure (Abs Type)) m)
         (NamesT (ExceptT (Closure (Abs Type)) m) (Abs Term))
    -> NamesT
         (ExceptT (Closure (Abs Type)) m)
         (NamesT (ExceptT (Closure (Abs Type)) m) Term,
          NamesT (ExceptT (Closure (Abs Type)) m) (Abs Term))
    forall a b.
    NamesT (ExceptT (Closure (Abs Type)) m) (a -> b)
    -> NamesT (ExceptT (Closure (Abs Type)) m) a
    -> NamesT (ExceptT (Closure (Abs Type)) m) b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Abs Term
    -> NamesT
         (ExceptT (Closure (Abs Type)) m)
         (NamesT (ExceptT (Closure (Abs Type)) m) (Abs Term))
    forall (m :: * -> *) a.
    (Monad m, Subst a) =>
    a -> NamesT m (NamesT m a)
    open (String -> Term -> Abs Term
    forall a. String -> a -> Abs a
    Abs String
    "i" Term
    upsi)
            phi <- open phi
            a   <- open $ unArg a
            b <- gTransp l t u phi a
            bf <- bind "i" $ \ forall b.
    (Subst b, DeBruijn b) =>
    NamesT (ExceptT (Closure (Abs Type)) m) b
    i -> do
                                Maybe (NamesT (ExceptT (Closure (Abs Type)) m) Term)
    -> NamesT (ExceptT (Closure (Abs Type)) m) (Abs Type)
    -> [(NamesT (ExceptT (Closure (Abs Type)) m) Term,
         NamesT (ExceptT (Closure (Abs Type)) m) (Abs Term))]
    -> NamesT (ExceptT (Closure (Abs Type)) m) Term
    -> NamesT (ExceptT (Closure (Abs Type)) m) Term
    -> NamesT (ExceptT (Closure (Abs Type)) m) Term
    gTransp (((NamesT (ExceptT (Closure (Abs Type)) m) Term
     -> NamesT (ExceptT (Closure (Abs Type)) m) Term)
    -> Maybe (NamesT (ExceptT (Closure (Abs Type)) m) Term)
    -> Maybe (NamesT (ExceptT (Closure (Abs Type)) m) Term)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Maybe (NamesT (ExceptT (Closure (Abs Type)) m) Term)
    l) ((NamesT (ExceptT (Closure (Abs Type)) m) Term
      -> NamesT (ExceptT (Closure (Abs Type)) m) Term)
     -> Maybe (NamesT (ExceptT (Closure (Abs Type)) m) Term))
    -> (NamesT (ExceptT (Closure (Abs Type)) m) Term
        -> NamesT (ExceptT (Closure (Abs Type)) m) Term)
    -> Maybe (NamesT (ExceptT (Closure (Abs Type)) m) Term)
    forall a b. (a -> b) -> a -> b
    $ \ NamesT (ExceptT (Closure (Abs Type)) m) Term
    l -> String
    -> (NamesT (ExceptT (Closure (Abs Type)) m) Term
        -> NamesT (ExceptT (Closure (Abs Type)) m) Term)
    -> NamesT (ExceptT (Closure (Abs Type)) m) Term
    forall (m :: * -> *).
    Monad m =>
    String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
    lam String
    "j" ((NamesT (ExceptT (Closure (Abs Type)) m) Term
      -> NamesT (ExceptT (Closure (Abs Type)) m) Term)
     -> NamesT (ExceptT (Closure (Abs Type)) m) Term)
    -> (NamesT (ExceptT (Closure (Abs Type)) m) Term
        -> NamesT (ExceptT (Closure (Abs Type)) m) Term)
    -> NamesT (ExceptT (Closure (Abs Type)) m) Term
    forall a b. (a -> b) -> a -> b
    $ \ NamesT (ExceptT (Closure (Abs Type)) m) Term
    j -> NamesT (ExceptT (Closure (Abs Type)) m) Term
    l NamesT (ExceptT (Closure (Abs Type)) m) Term
    -> NamesT (ExceptT (Closure (Abs Type)) m) Term
    -> NamesT (ExceptT (Closure (Abs Type)) m) Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <@> (Term -> NamesT (ExceptT (Closure (Abs Type)) m) Term
    forall a. a -> NamesT (ExceptT (Closure (Abs Type)) m) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Term
    imin NamesT (ExceptT (Closure (Abs Type)) m) Term
    -> NamesT (ExceptT (Closure (Abs Type)) m) Term
    -> NamesT (ExceptT (Closure (Abs Type)) m) Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <@> NamesT (ExceptT (Closure (Abs Type)) m) Term
    forall b.
    (Subst b, DeBruijn b) =>
    NamesT (ExceptT (Closure (Abs Type)) m) b
    i NamesT (ExceptT (Closure (Abs Type)) m) Term
    -> NamesT (ExceptT (Closure (Abs Type)) m) Term
    -> NamesT (ExceptT (Closure (Abs Type)) m) Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <@> NamesT (ExceptT (Closure (Abs Type)) m) Term
    j))
                                        (String
    -> ((forall b.
         (Subst b, DeBruijn b) =>
         NamesT (ExceptT (Closure (Abs Type)) m) b)
        -> NamesT (ExceptT (Closure (Abs Type)) m) Type)
    -> NamesT (ExceptT (Closure (Abs Type)) m) (Abs 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 (ExceptT (Closure (Abs Type)) m) b)
      -> NamesT (ExceptT (Closure (Abs Type)) m) Type)
     -> NamesT (ExceptT (Closure (Abs Type)) m) (Abs Type))
    -> ((forall b.
         (Subst b, DeBruijn b) =>
         NamesT (ExceptT (Closure (Abs Type)) m) b)
        -> NamesT (ExceptT (Closure (Abs Type)) m) Type)
    -> NamesT (ExceptT (Closure (Abs Type)) m) (Abs Type)
    forall a b. (a -> b) -> a -> b
    $ \ forall b.
    (Subst b, DeBruijn b) =>
    NamesT (ExceptT (Closure (Abs Type)) m) b
    j -> NamesT (ExceptT (Closure (Abs Type)) m) (Abs Type)
    t NamesT (ExceptT (Closure (Abs Type)) m) (Abs Type)
    -> NamesT (ExceptT (Closure (Abs Type)) m) (SubstArg Type)
    -> NamesT (ExceptT (Closure (Abs Type)) m) Type
    forall (m :: * -> *) a.
    (Applicative m, Subst a) =>
    m (Abs a) -> m (SubstArg a) -> m a
    `bapp` (Term -> NamesT (ExceptT (Closure (Abs Type)) m) Term
    forall a. a -> NamesT (ExceptT (Closure (Abs Type)) m) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Term
    imin NamesT (ExceptT (Closure (Abs Type)) m) Term
    -> NamesT (ExceptT (Closure (Abs Type)) m) Term
    -> NamesT (ExceptT (Closure (Abs Type)) m) Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <@> NamesT (ExceptT (Closure (Abs Type)) m) Term
    forall b.
    (Subst b, DeBruijn b) =>
    NamesT (ExceptT (Closure (Abs Type)) m) b
    i NamesT (ExceptT (Closure (Abs Type)) m) Term
    -> NamesT (ExceptT (Closure (Abs Type)) m) Term
    -> NamesT (ExceptT (Closure (Abs Type)) m) Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <@> NamesT (ExceptT (Closure (Abs Type)) m) Term
    forall b.
    (Subst b, DeBruijn b) =>
    NamesT (ExceptT (Closure (Abs Type)) m) b
    j))
                                        [(NamesT (ExceptT (Closure (Abs Type)) m) Term,
      NamesT (ExceptT (Closure (Abs Type)) m) (Abs Term))]
    u
                                        (Term -> NamesT (ExceptT (Closure (Abs Type)) m) Term
    forall a. a -> NamesT (ExceptT (Closure (Abs Type)) m) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Term
    imax NamesT (ExceptT (Closure (Abs Type)) m) Term
    -> NamesT (ExceptT (Closure (Abs Type)) m) Term
    -> NamesT (ExceptT (Closure (Abs Type)) m) Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <@> (Term -> NamesT (ExceptT (Closure (Abs Type)) m) Term
    forall a. a -> NamesT (ExceptT (Closure (Abs Type)) m) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Term
    ineg NamesT (ExceptT (Closure (Abs Type)) m) Term
    -> NamesT (ExceptT (Closure (Abs Type)) m) Term
    -> NamesT (ExceptT (Closure (Abs Type)) m) Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <@> NamesT (ExceptT (Closure (Abs Type)) m) Term
    forall b.
    (Subst b, DeBruijn b) =>
    NamesT (ExceptT (Closure (Abs Type)) m) b
    i) NamesT (ExceptT (Closure (Abs Type)) m) Term
    -> NamesT (ExceptT (Closure (Abs Type)) m) Term
    -> NamesT (ExceptT (Closure (Abs Type)) m) Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <@> NamesT (ExceptT (Closure (Abs Type)) m) Term
    phi)
                                        NamesT (ExceptT (Closure (Abs Type)) m) Term
    a
            return (b, absBody bf)
          (:) (b <$ a) <$> go (lazyAbsApp delta bf) us phi args
        go Telescope
    EmptyTel            [[(Term, Term)]]
    _ Term
    _ [Arg Term]
    _ = ExceptT (Closure (Abs Type)) m [Arg Term]
    forall a. HasCallStack => a
    __IMPOSSIBLE__
        go (ExtendTel Dom' Term Type
    t Abs Telescope
    delta) [[(Term, Term)]]
    _ Term
    _ [Arg Term]
    _ = ExceptT (Closure (Abs Type)) m [Arg Term]
    forall a. HasCallStack => a
    __IMPOSSIBLE__
      let (psis,uss) = unzip us
          us' | [(Term, Abs [Term])] -> Bool
    forall a. Null a => a -> Bool
    null [(Term, Abs [Term])]
    us = Nat -> [(Term, Term)] -> [[(Term, Term)]]
    forall a. Nat -> a -> [a]
    replicate ([Arg Term] -> Nat
    forall a. [a] -> Nat
    forall (t :: * -> *) a. Foldable t => t a -> Nat
    length [Arg Term]
    args) []
              | Bool
    otherwise = ([Term] -> [(Term, Term)]) -> [[Term]] -> [[(Term, Term)]]
    forall a b. (a -> b) -> [a] -> [b]
    map ([Term] -> [Term] -> [(Term, Term)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [Term]
    psis) ([[Term]] -> [[(Term, Term)]]) -> [[Term]] -> [[(Term, Term)]]
    forall a b. (a -> b) -> a -> b
    $ [[Term]] -> [[Term]]
    forall a. [[a]] -> [[a]]
    List.transpose ((Abs [Term] -> [Term]) -> [Abs [Term]] -> [[Term]]
    forall a b. (a -> b) -> [a] -> [b]
    map Abs [Term] -> [Term]
    forall a. Subst a => Abs a -> a
    absBody [Abs [Term]]
    uss)
      go (absBody delta) us' phi args

    -- | Like @transpTel@ but performing a transpFill.
    trFillTel :: Abs Telescope -- Γ ⊢ i.Δ
              -> Term
              -> Args          -- Γ ⊢ δ : Δ[0]
              -> Term          -- Γ ⊢ r : I
              -> ExceptT (Closure (Abs Type)) TCM Args      -- Γ ⊢ Δ[r]
    trFillTel :: Abs Telescope
    -> Term
    -> [Arg Term]
    -> Term
    -> ExceptT (Closure (Abs Type)) (TCMT IO) [Arg Term]
    trFillTel = Bool
    -> Abs Telescope
    -> Term
    -> [Arg Term]
    -> Term
    -> ExceptT (Closure (Abs Type)) (TCMT IO) [Arg Term]
    forall (m :: * -> *).
    (PureTCM m, MonadError TCErr m) =>
    Bool
    -> Abs Telescope
    -> Term
    -> [Arg Term]
    -> Term
    -> ExceptT (Closure (Abs Type)) m [Arg Term]
    trFillTel' Bool
    False

    trFillTel' :: (PureTCM m, MonadError TCErr m) =>
              Bool
              -> Abs Telescope -- Γ ⊢ i.Δ
              -> Term
              -> Args          -- Γ ⊢ δ : Δ[0]
              -> Term          -- Γ ⊢ r : I
              -> ExceptT (Closure (Abs Type)) m Args      -- Γ ⊢ Δ[r]
    trFillTel' :: forall (m :: * -> *).
    (PureTCM m, MonadError TCErr m) =>
    Bool
    -> Abs Telescope
    -> Term
    -> [Arg Term]
    -> Term
    -> ExceptT (Closure (Abs Type)) m [Arg Term]
    trFillTel' Bool
    flag Abs Telescope
    delta Term
    phi [Arg Term]
    args Term
    r = do
      imin <- m Term -> ExceptT (Closure (Abs Type)) m Term
    forall (m :: * -> *) a.
    Monad m =>
    m a -> ExceptT (Closure (Abs Type)) m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift m Term
    forall (m :: * -> *).
    (HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
    m Term
    primIMin
      imax <- lift primIMax
      ineg <- lift primINeg
      transpTel' flag (Abs "j" $ raise 1 delta `lazyAbsApp` (imin `apply` (map argN [var 0, raise 1 r])))
                (imax `apply` [argN $ ineg `apply` [argN r], argN phi])
                args

    -- hcompTel' :: Bool -> Telescope -> [(Term,Abs [Term])] -> [Term] -> ExceptT (Closure (Abs Type)) TCM [Term]
    -- hcompTel' b delta sides base = undefined

    -- hFillTel' :: Bool -> Telescope -- Γ ⊢ Δ
    --           -> [(Term,Abs [Term])]  -- [(φ,i.δ)] with  Γ,φ ⊢ i.δ : I → Δ
    --           -> [Term]            -- Γ ⊢ δ0 : Δ, matching the [(φ,i.δ)]
    --           -> Term -- Γ ⊢ r : I
    --           -> ExceptT (Closure (Abs Type)) TCM [Term]
    -- hFillTel' b delta sides base = undefined

    pathTelescope :: forall m. (PureTCM m, MonadError TCErr m)
      => Telescope  -- ^ Δ
      -> [Arg Term] -- ^ lhs : Δ
      -> [Arg Term] -- ^ rhs : Δ
      -> m Telescope
    pathTelescope :: forall (m :: * -> *).
    (PureTCM m, MonadError TCErr m) =>
    Telescope -> [Arg Term] -> [Arg Term] -> m Telescope
    pathTelescope Telescope
    tel [Arg Term]
    lhs [Arg Term]
    rhs = do
      ExceptT (Closure Type) m Telescope
    -> m (Either (Closure Type) Telescope)
    forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
    runExceptT (Telescope
    -> [Arg Term] -> [Arg Term] -> ExceptT (Closure Type) m Telescope
    forall (m :: * -> *).
    (PureTCM m, MonadError (Closure Type) m) =>
    Telescope -> [Arg Term] -> [Arg Term] -> m Telescope
    pathTelescope' Telescope
    tel [Arg Term]
    lhs [Arg Term]
    rhs) m (Either (Closure Type) Telescope)
    -> (Either (Closure Type) Telescope -> m Telescope) -> m Telescope
    forall a b. m a -> (a -> m b) -> m b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \case
        Left Closure Type
    t -> do
          Closure Type -> (Type -> m Telescope) -> m Telescope
    forall (m :: * -> *) c a b.
    (MonadTCEnv m, ReadTCState m, LensClosure c a) =>
    c -> (a -> m b) -> m b
    enterClosure Closure Type
    t ((Type -> m Telescope) -> m Telescope)
    -> (Type -> m Telescope) -> m Telescope
    forall a b. (a -> b) -> a -> b
    $ \ Type
    t ->
                     TypeError -> m Telescope
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCError m) =>
    TypeError -> m a
    typeError (TypeError -> m Telescope)
    -> (Doc -> TypeError) -> Doc -> m Telescope
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Doc -> TypeError
    GenericDocError (Doc -> m Telescope) -> m Doc -> m Telescope
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<<
                        (String -> m Doc
    forall (m :: * -> *). Applicative m => String -> m Doc
    text String
    "The sort of" m Doc -> m Doc -> m Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> Type -> m Doc
    forall (m :: * -> *) a. (Applicative m, Pretty a) => a -> m Doc
    pretty Type
    t m Doc -> m Doc -> m Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> String -> m Doc
    forall (m :: * -> *). Applicative m => String -> m Doc
    text String
    "should be of the form \"Set l\"")
        Right Telescope
    tel -> Telescope -> m Telescope
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Telescope
    tel

    pathTelescope' :: forall m. (PureTCM m, MonadError (Closure Type) m)
      => Telescope  -- ^ Δ
      -> [Arg Term] -- ^ lhs : Δ
      -> [Arg Term] -- ^ rhs : Δ
      -> m Telescope
    pathTelescope' :: forall (m :: * -> *).
    (PureTCM m, MonadError (Closure Type) m) =>
    Telescope -> [Arg Term] -> [Arg Term] -> m Telescope
    pathTelescope' Telescope
    tel [Arg Term]
    lhs [Arg Term]
    rhs = do
      pathp <- Term -> Maybe Term -> Term
    forall a. a -> Maybe a -> a
    fromMaybe Term
    forall a. HasCallStack => a
    __IMPOSSIBLE__ (Maybe Term -> Term) -> m (Maybe Term) -> m Term
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> BuiltinId -> m (Maybe Term)
    forall (m :: * -> *) a.
    (HasBuiltins m, IsBuiltin a) =>
    a -> m (Maybe Term)
    getTerm' BuiltinId
    builtinPathP
      go pathp (raise 1 tel) lhs rhs
     where
      -- Γ,i ⊢ Δ, Γ ⊢ lhs : Δ[0], Γ ⊢ rhs : Δ[1]
      go :: Term -> Telescope -> [Arg Term] -> [Arg Term] -> m Telescope
      go :: Term -> Telescope -> [Arg Term] -> [Arg Term] -> m Telescope
    go Term
    pathp (ExtendTel Dom' Term Type
    a Abs Telescope
    tel) (Arg Term
    u : [Arg Term]
    lhs) (Arg Term
    v : [Arg Term]
    rhs) = do
        let t :: Type
    t = Dom' Term Type -> Type
    forall t e. Dom' t e -> e
    unDom Dom' Term Type
    a
        l <- Nat -> SubstArg (Level' Term) -> Level' Term -> Level' Term
    forall a. Subst a => Nat -> SubstArg a -> a -> a
    subst Nat
    0 Term
    SubstArg (Level' Term)
    HasCallStack => Term
    __DUMMY_TERM__ (Level' Term -> Level' Term) -> m (Level' Term) -> m (Level' Term)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Type -> m (Level' Term)
    getLevel Type
    t
        let a' = Sort -> Term -> Type
    forall t a. Sort' t -> a -> Type'' t a
    El (Level' Term -> Sort
    forall t. Level' t -> Sort' t
    Type Level' Term
    l) (Term -> [Arg Term] -> Term
    forall t. Apply t => t -> [Arg Term] -> t
    apply Term
    pathp ([Arg Term] -> Term) -> [Arg Term] -> Term
    forall a b. (a -> b) -> a -> b
    $ [Term -> Arg Term
    forall e. e -> Arg e
    argH (Term -> Arg Term) -> Term -> Arg Term
    forall a b. (a -> b) -> a -> b
    $ Level' Term -> Term
    Level Level' Term
    l] [Arg Term] -> [Arg Term] -> [Arg Term]
    forall a. [a] -> [a] -> [a]
    ++ (Term -> Arg Term) -> [Term] -> [Arg Term]
    forall a b. (a -> b) -> [a] -> [b]
    map Term -> Arg Term
    forall e. e -> Arg e
    argN [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
    t), Arg Term -> Term
    forall e. Arg e -> e
    unArg Arg Term
    u, Arg Term -> Term
    forall e. Arg e -> e
    unArg Arg Term
    v])
            -- Γ,eq : u ≡ v, i : I ⊢ m = eq i : t[i]
            -- m  = runNames [] $ do
            --        [u,v] <- mapM (open . unArg) [u,v]
            --        bind "eq" $ \ eq -> bind "i" $ \ i ->
        (ExtendTel (a' <$ a) <$>) . runNamesT [] $ do
          let nm = (Abs Telescope -> String
    forall a. Abs a -> String
    absName Abs Telescope
    tel)
          tel <- open $ Abs "i" tel
          u   <- open $ unArg u
          v   <- open $ unArg v
          lhs <- open lhs
          rhs <- open rhs
          bind nm $ \ forall b. (Subst b, DeBruijn b) => NamesT m b
    eq -> do
            lhs <- NamesT m [Arg Term]
    lhs
            rhs <- rhs
            tel' <- bind "i" $ \ forall b. (Subst b, DeBruijn b) => NamesT m b
    i ->
                      Abs Telescope -> Term -> Telescope
    Abs Telescope -> SubstArg Telescope -> Telescope
    forall a. Subst a => Abs a -> SubstArg a -> a
    lazyAbsApp (Abs Telescope -> Term -> Telescope)
    -> NamesT m (Abs Telescope) -> NamesT m (Term -> Telescope)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Abs (Abs Telescope) -> Term -> Abs Telescope
    Abs (Abs Telescope) -> SubstArg (Abs Telescope) -> Abs Telescope
    forall a. Subst a => Abs a -> SubstArg a -> a
    lazyAbsApp (Abs (Abs Telescope) -> Term -> Abs Telescope)
    -> NamesT m (Abs (Abs Telescope))
    -> NamesT m (Term -> Abs Telescope)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> NamesT m (Abs (Abs Telescope))
    tel NamesT m (Term -> Abs Telescope)
    -> NamesT m Term -> NamesT m (Abs Telescope)
    forall a b. NamesT m (a -> b) -> NamesT m a -> NamesT m b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> NamesT m Term
    forall b. (Subst b, DeBruijn b) => NamesT m b
    i) NamesT m (Term -> Telescope) -> NamesT m Term -> NamesT m Telescope
    forall a b. NamesT m (a -> b) -> NamesT m a -> NamesT m b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> (NamesT m Term
    forall b. (Subst b, DeBruijn b) => NamesT m b
    eq NamesT m Term
    -> (NamesT m Term, NamesT m Term, NamesT m Term) -> NamesT m Term
    forall (m :: * -> *).
    Applicative m =>
    m Term -> (m Term, m Term, m Term) -> m Term
    <@@> (NamesT m Term
    u, NamesT m Term
    v, NamesT m Term
    forall b. (Subst b, DeBruijn b) => NamesT m b
    i))
            lift $ go pathp (absBody tel') lhs rhs
      go Term
    _ Telescope
    EmptyTel [] [] = Telescope -> m Telescope
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Telescope
    forall a. Tele a
    EmptyTel
      go Term
    _ Telescope
    _ [Arg Term]
    _ [Arg Term]
    _ = m Telescope
    forall a. HasCallStack => a
    __IMPOSSIBLE__
      getLevel :: Type -> m Level
      getLevel :: Type -> m (Level' Term)
    getLevel Type
    t = do
        s <- Sort -> m Sort
    forall a (m :: * -> *). (Reduce a, MonadReduce m) => a -> m a
    reduce (Sort -> m Sort) -> Sort -> m Sort
    forall a b. (a -> b) -> a -> b
    $ Type -> Sort
    forall a. LensSort a => a -> Sort
    getSort Type
    t
        case s of
          Type Level' Term
    l -> Level' Term -> m (Level' Term)
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Level' Term
    l
          Sort
    s      -> Closure Type -> m (Level' Term)
    forall a. Closure Type -> m a
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError (Closure Type -> m (Level' Term))
    -> m (Closure Type) -> m (Level' Term)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< Type -> m (Closure Type)
    forall (m :: * -> *) a.
    (MonadTCEnv m, ReadTCState m) =>
    a -> m (Closure a)
    buildClosure Type
    t

    data TranspError = CannotTransp {TranspError -> Closure (Abs Type)
    errorType :: (Closure (Abs Type)) }

    instance Exception TranspError
    instance Show TranspError where
      show :: TranspError -> String
    show TranspError
    _ = String
    "TranspError"

    tryTranspError :: TCM a -> TCM (Either (Closure (Abs Type)) a)
    tryTranspError :: forall a. TCM a -> TCM (Either (Closure (Abs Type)) a)
    tryTranspError (TCM IORef TCState -> TCEnv -> IO a
    m) = (IORef TCState -> TCEnv -> IO (Either (Closure (Abs Type)) a))
    -> TCMT IO (Either (Closure (Abs Type)) a)
    forall (m :: * -> *) a. (IORef TCState -> TCEnv -> m a) -> TCMT m a
    TCM ((IORef TCState -> TCEnv -> IO (Either (Closure (Abs Type)) a))
     -> TCMT IO (Either (Closure (Abs Type)) a))
    -> (IORef TCState -> TCEnv -> IO (Either (Closure (Abs Type)) a))
    -> TCMT IO (Either (Closure (Abs Type)) a)
    forall a b. (a -> b) -> a -> b
    $ \ IORef TCState
    s TCEnv
    env -> do
      (TranspError -> Closure (Abs Type))
    -> Either TranspError a -> Either (Closure (Abs Type)) a
    forall a c b. (a -> c) -> Either a b -> Either c b
    mapLeft TranspError -> Closure (Abs Type)
    errorType (Either TranspError a -> Either (Closure (Abs Type)) a)
    -> IO (Either TranspError a) -> IO (Either (Closure (Abs Type)) a)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (IO a -> IO (Either TranspError a)
    forall e a. Exception e => IO a -> IO (Either e a)
    try (IORef TCState -> TCEnv -> IO a
    m IORef TCState
    s TCEnv
    env))

    transpPathPTel' ::
                 NamesT TCM (Abs (Abs Telescope)) -- ^ j.i.Δ                 const on φ
                 -> [NamesT TCM Term]          -- ^ x : (i : I) → Δ[0,i]  const on φ
                 -> [NamesT TCM Term]          -- ^ y : (i : I) → Δ[1,i]  const on φ
                 -> NamesT TCM Term            -- ^ φ
                 -> [NamesT TCM Term]          -- ^ p : PathP (λ j → Δ[j,0]) (x 0) (y 0)
                 -> NamesT TCM [Arg Term] -- PathP (λ j → Δ[j,0]) (x 1) (y 1) [ φ ↦ q ]
    transpPathPTel' :: NamesT (TCMT IO) (Abs (Abs Telescope))
    -> [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 Telescope))
    theTel [NamesT (TCMT IO) Term]
    x [NamesT (TCMT IO) Term]
    y NamesT (TCMT IO) Term
    phi [NamesT (TCMT IO) Term]
    p = do
     let neg :: NamesT m Term -> NamesT m Term
    neg 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
    primINeg NamesT m Term -> NamesT m Term -> NamesT m Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <@> NamesT m Term
    j
     -- is the open overkill?
     qs <- ([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] -> NamesT (TCMT IO) (NamesT (TCMT IO) [Arg Term]))
    -> NamesT (TCMT IO) [Arg Term]
    -> NamesT (TCMT IO) (NamesT (TCMT IO) [Arg Term])
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<<) (NamesT (TCMT IO) [Arg Term]
     -> NamesT (TCMT IO) (NamesT (TCMT IO) [Arg Term]))
    -> NamesT (TCMT IO) [Arg Term]
    -> NamesT (TCMT IO) (NamesT (TCMT IO) [Arg Term])
    forall a b. (a -> b) -> a -> b
    $ (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 (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])
    -> (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 :: * -> *) (f :: * -> *) a.
    (Traversable t, Applicative f) =>
    t (f a) -> f (t a)
    forall (f :: * -> *) a. Applicative f => Abs (f a) -> f (Abs a)
    sequenceA)
                      (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
    "j" (((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
    j -> do
       theTel <- Abs (Abs Telescope) -> Term -> Abs Telescope
    Abs (Abs Telescope) -> SubstArg (Abs Telescope) -> Abs Telescope
    forall a. Subst a => Abs a -> SubstArg a -> a
    absApp (Abs (Abs Telescope) -> Term -> Abs Telescope)
    -> NamesT (TCMT IO) (Abs (Abs Telescope))
    -> NamesT (TCMT IO) (Term -> Abs Telescope)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> NamesT (TCMT IO) (Abs (Abs Telescope))
    theTel NamesT (TCMT IO) (Term -> Abs Telescope)
    -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) (Abs Telescope)
    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
       faces <- sequence [neg j, j]
       us <- forM [x,y] $ \ [NamesT (TCMT IO) Term]
    z -> do
               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 -> [NamesT (TCMT IO) Term]
    -> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
    -> NamesT (TCMT IO) [Term]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    t a -> (a -> m b) -> m (t b)
    forM [NamesT (TCMT IO) Term]
    z (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)
       let sys = [Term] -> [Abs [Term]] -> [(Term, Abs [Term])]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [Term]
    faces [Abs [Term]]
    us
       -- [(neg j, bind "i" $ \ i -> flip map x (<@> i))
       -- ,(j , bind "i" $ \ i -> flip map y (<@> i))]
       phi <- phi
       p0 <- mapM (<@> j) p
       let toArgs = (Arg String -> Term -> Arg Term)
    -> [Arg String] -> [Term] -> [Arg Term]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith (\ Arg String
    a Term
    t -> Term
    t 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
    a) (Telescope -> [Arg String]
    teleArgNames (Abs Telescope -> Telescope
    forall a. Abs a -> a
    unAbs (Abs Telescope -> Telescope) -> Abs Telescope -> Telescope
    forall a b. (a -> b) -> a -> b
    $ Abs Telescope
    theTel))
       eq <- lift . runExceptT $ transpSysTel' False theTel sys phi (toArgs p0)
       either (lift . lift . throw . CannotTransp) pure eq
     qs

    transpPathTel' ::
                 NamesT TCM (Abs Telescope) -- ^ i.Δ                 const on φ
                 -> [NamesT TCM Term]          -- ^ x : (i : I) → Δ[i]  const on φ
                 -> [NamesT TCM Term]          -- ^ y : (i : I) → Δ[i]  const on φ
                 -> NamesT TCM Term            -- ^ φ
                 -> [NamesT TCM Term]          -- ^ p : Path (Δ[0]) (x 0) (y 0)
                 -> NamesT TCM [Arg Term] -- Path (Δ[1]) (x 1) (y 1) [ φ ↦ q ]
    transpPathTel' :: NamesT (TCMT IO) (Abs Telescope)
    -> [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 Telescope)
    theTel [NamesT (TCMT IO) Term]
    x [NamesT (TCMT IO) Term]
    y NamesT (TCMT IO) Term
    phi [NamesT (TCMT IO) Term]
    p = do
     let neg :: NamesT m Term -> NamesT m Term
    neg 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
    primINeg NamesT m Term -> NamesT m Term -> NamesT m Term
    forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
    <@> NamesT m Term
    j
     -- is the open overkill?
     qs <- ([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] -> NamesT (TCMT IO) (NamesT (TCMT IO) [Arg Term]))
    -> NamesT (TCMT IO) [Arg Term]
    -> NamesT (TCMT IO) (NamesT (TCMT IO) [Arg Term])
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<<) (NamesT (TCMT IO) [Arg Term]
     -> NamesT (TCMT IO) (NamesT (TCMT IO) [Arg Term]))
    -> NamesT (TCMT IO) [Arg Term]
    -> NamesT (TCMT IO) (NamesT (TCMT IO) [Arg Term])
    forall a b. (a -> b) -> a -> b
    $ (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 (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])
    -> (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 :: * -> *) (f :: * -> *) a.
    (Traversable t, Applicative f) =>
    t (f a) -> f (t a)
    forall (f :: * -> *) a. Applicative f => Abs (f a) -> f (Abs a)
    sequenceA)
                      (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
    "j" (((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
    j -> do
       theTel <- NamesT (TCMT IO) (Abs Telescope)
    theTel
       faces <- sequence $ [neg j, j]
       us <- forM [x,y] $ \ [NamesT (TCMT IO) Term]
    z -> do
               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 -> [NamesT (TCMT IO) Term]
    -> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
    -> NamesT (TCMT IO) [Term]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    t a -> (a -> m b) -> m (t b)
    forM [NamesT (TCMT IO) Term]
    z (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)
       let sys = [Term] -> [Abs [Term]] -> [(Term, Abs [Term])]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [Term]
    faces [Abs [Term]]
    us
       -- [(neg j, bind "i" $ \ i -> flip map x (<@> i))
       -- ,(j , bind "i" $ \ i -> flip map y (<@> i))]
       phi <- phi
       p0 <- mapM (<@> j) p
       let toArgs = (Arg String -> Term -> Arg Term)
    -> [Arg String] -> [Term] -> [Arg Term]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith (\ Arg String
    a Term
    t -> Term
    t 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
    a) (Telescope -> [Arg String]
    teleArgNames (Abs Telescope -> Telescope
    forall a. Abs a -> a
    unAbs Abs Telescope
    theTel))
       eq <- lift . runExceptT $ transpSysTel' False theTel sys phi (toArgs p0)
       either (lift . lift . throw . CannotTransp) pure eq
     qs

    trFillPathTel' ::
                   NamesT TCM (Abs Telescope) -- ^ i.Δ                 const on φ
                 -> [NamesT TCM Term]          -- ^ x : (i : I) → Δ[i]  const on φ
                 -> [NamesT TCM Term]          -- ^ y : (i : I) → Δ[i]  const on φ
                 -> NamesT TCM Term            -- ^ φ
                 -> [NamesT TCM Term]          -- ^ p : Path (Δ[0]) (x 0) (y 0)
                 -> NamesT TCM Term            -- ^ r
                 -> NamesT TCM [Arg Term] -- Path (Δ[r]) (x r) (y r) [ φ ↦ q; (r = 0) ↦ q ]
    trFillPathTel' :: NamesT (TCMT IO) (Abs Telescope)
    -> [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]
    trFillPathTel' NamesT (TCMT IO) (Abs Telescope)
    tel [NamesT (TCMT IO) Term]
    x [NamesT (TCMT IO) Term]
    y NamesT (TCMT IO) Term
    phi [NamesT (TCMT IO) Term]
    p NamesT (TCMT IO) Term
    r = do
      let max :: NamesT m Term -> NamesT m Term -> NamesT m Term
    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
    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 min :: NamesT m Term -> NamesT m Term -> NamesT m Term
    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 -> NamesT m Term
    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
      x' <- ((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
    "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 -> [NamesT (TCMT IO) Term]
    -> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
    -> NamesT (TCMT IO) [Term]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    t a -> (a -> m b) -> m (t b)
    forM [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
    -> 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
    r NamesT (TCMT IO) Term
    forall b. (Subst b, DeBruijn b) => NamesT (TCMT IO) b
    i))
      y' <- (mapM open =<<) $ lamTel $ bind "i" $ \ forall b. (Subst b, DeBruijn b) => NamesT (TCMT IO) b
    i -> [NamesT (TCMT IO) Term]
    -> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
    -> NamesT (TCMT IO) [Term]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    t a -> (a -> m b) -> m (t b)
    forM [NamesT (TCMT IO) Term]
    y (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
    min NamesT (TCMT IO) Term
    r NamesT (TCMT IO) Term
    forall b. (Subst b, DeBruijn b) => NamesT (TCMT IO) b
    i))
      transpPathTel' (bind "i" $ \ forall b. (Subst b, DeBruijn b) => NamesT (TCMT IO) b
    i -> Abs Telescope -> Term -> Telescope
    Abs Telescope -> SubstArg Telescope -> Telescope
    forall a. Subst a => Abs a -> SubstArg a -> a
    absApp (Abs Telescope -> Term -> Telescope)
    -> NamesT (TCMT IO) (Abs Telescope)
    -> NamesT (TCMT IO) (Term -> Telescope)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> NamesT (TCMT IO) (Abs Telescope)
    tel NamesT (TCMT IO) (Term -> Telescope)
    -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Telescope
    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
    -> 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
    r NamesT (TCMT IO) Term
    forall b. (Subst b, DeBruijn b) => NamesT (TCMT IO) b
    i)
                     x'
                     y'
                     (max phi (neg r))
                     p

    trFillPathPTel' ::
                   NamesT TCM (Abs (Abs Telescope)) -- ^ j.i.Δ                 const on φ
                 -> [NamesT TCM Term]          -- ^ x : (i : I) → Δ[0,i]  const on φ
                 -> [NamesT TCM Term]          -- ^ y : (i : I) → Δ[1,i]  const on φ
                 -> NamesT TCM Term            -- ^ φ
                 -> [NamesT TCM Term]          -- ^ p : Path (\ j -> Δ[j,0]) (x 0) (y 0)
                 -> NamesT TCM Term            -- ^ r
                 -> NamesT TCM [Arg Term] -- Path (\ j → Δ[j,r]) (x r) (y r) [ φ ↦ q; (r = 0) ↦ q ]
    trFillPathPTel' :: NamesT (TCMT IO) (Abs (Abs Telescope))
    -> [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 Telescope))
    tel [NamesT (TCMT IO) Term]
    x [NamesT (TCMT IO) Term]
    y NamesT (TCMT IO) Term
    phi [NamesT (TCMT IO) Term]
    p NamesT (TCMT IO) Term
    r = do
      let max :: NamesT m Term -> NamesT m Term -> NamesT m Term
    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
    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 min :: NamesT m Term -> NamesT m Term -> NamesT m Term
    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 -> NamesT m Term
    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
      x' <- ((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
    "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 -> [NamesT (TCMT IO) Term]
    -> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
    -> NamesT (TCMT IO) [Term]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    t a -> (a -> m b) -> m (t b)
    forM [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
    -> 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
    r NamesT (TCMT IO) Term
    forall b. (Subst b, DeBruijn b) => NamesT (TCMT IO) b
    i))
      y' <- (mapM open =<<) $ lamTel $ bind "i" $ \ forall b. (Subst b, DeBruijn b) => NamesT (TCMT IO) b
    i -> [NamesT (TCMT IO) Term]
    -> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
    -> NamesT (TCMT IO) [Term]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    t a -> (a -> m b) -> m (t b)
    forM [NamesT (TCMT IO) Term]
    y (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
    min NamesT (TCMT IO) Term
    r NamesT (TCMT IO) Term
    forall b. (Subst b, DeBruijn b) => NamesT (TCMT IO) b
    i))
      transpPathPTel' (bind "j" $ \ 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) Telescope)
    -> NamesT (TCMT IO) (Abs Telescope)
    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) Telescope)
     -> NamesT (TCMT IO) (Abs Telescope))
    -> ((forall b. (Subst b, DeBruijn b) => NamesT (TCMT IO) b)
        -> NamesT (TCMT IO) Telescope)
    -> NamesT (TCMT IO) (Abs Telescope)
    forall a b. (a -> b) -> a -> b
    $ \ forall b. (Subst b, DeBruijn b) => NamesT (TCMT IO) b
    i -> Abs Telescope -> Term -> Telescope
    Abs Telescope -> SubstArg Telescope -> Telescope
    forall a. Subst a => Abs a -> SubstArg a -> a
    absApp (Abs Telescope -> Term -> Telescope)
    -> NamesT (TCMT IO) (Abs Telescope)
    -> NamesT (TCMT IO) (Term -> Telescope)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Abs (Abs Telescope) -> Term -> Abs Telescope
    Abs (Abs Telescope) -> SubstArg (Abs Telescope) -> Abs Telescope
    forall a. Subst a => Abs a -> SubstArg a -> a
    absApp (Abs (Abs Telescope) -> Term -> Abs Telescope)
    -> NamesT (TCMT IO) (Abs (Abs Telescope))
    -> NamesT (TCMT IO) (Term -> Abs Telescope)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> NamesT (TCMT IO) (Abs (Abs Telescope))
    tel NamesT (TCMT IO) (Term -> Abs Telescope)
    -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) (Abs Telescope)
    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 -> Telescope)
    -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Telescope
    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
    -> 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
    r NamesT (TCMT IO) Term
    forall b. (Subst b, DeBruijn b) => NamesT (TCMT IO) b
    i)
                     x'
                     y'
                     (max phi (neg r))
                     p

    -- given Γ ⊢ I type, and Γ ⊢ Δ telescope, build Δ^I such that
    -- Γ ⊢ (x : A, y : B x, ...)^I = (x : I → A, y : (i : I) → B (x i), ...)
    expTelescope :: Type -> Telescope -> Telescope
    expTelescope :: Type -> Telescope -> Telescope
    expTelescope Type
    int Telescope
    tel = Names -> [Dom' Term Type] -> Telescope
    unflattenTel Names
    names [Dom' Term Type]
    ys
      where
        stel :: Nat
    stel = Telescope -> Nat
    forall a. Sized a => a -> Nat
    size Telescope
    tel
        xs :: [Dom' Term Type]
    xs = Telescope -> [Dom' Term Type]
    forall a. TermSubst a => Tele (Dom a) -> [Dom a]
    flattenTel Telescope
    tel
        names :: Names
    names = Telescope -> Names
    teleNames Telescope
    tel
        t :: Telescope
    t = Dom' Term Type -> Abs Telescope -> Telescope
    forall a. a -> Abs (Tele a) -> Tele a
    ExtendTel (Type -> Dom' Term Type
    forall a. a -> Dom a
    defaultDom (Type -> Dom' Term Type) -> Type -> Dom' Term Type
    forall a b. (a -> b) -> a -> b
    $ Nat -> Type -> Type
    forall a. Subst a => Nat -> a -> a
    raise Nat
    stel Type
    int) (String -> Telescope -> Abs Telescope
    forall a. String -> a -> Abs a
    Abs String
    "i" Telescope
    forall a. Tele a
    EmptyTel)
        s :: Substitution' Term
    s = Nat -> Substitution' Term
    expS Nat
    stel
        ys :: [Dom' Term Type]
    ys = (Dom' Term Type -> Dom' Term Type)
    -> [Dom' Term Type] -> [Dom' Term Type]
    forall a b. (a -> b) -> [a] -> [b]
    map ((Type -> Type) -> Dom' Term Type -> Dom' Term 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 (Telescope -> Type -> Type
    forall t. Abstract t => Telescope -> t -> t
    abstract Telescope
    t) (Dom' Term Type -> Dom' Term Type)
    -> (Dom' Term Type -> Dom' Term Type)
    -> Dom' Term Type
    -> Dom' Term Type
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Substitution' (SubstArg (Dom' Term Type))
    -> Dom' Term Type -> Dom' Term Type
    forall a. Subst a => Substitution' (SubstArg a) -> a -> a
    applySubst Substitution' Term
    Substitution' (SubstArg (Dom' Term Type))
    s) [Dom' Term Type]
    xs

    -- | Γ, Δ^I, i : I |- expS |Δ| : Γ, Δ
    expS :: Nat -> Substitution
    expS :: Nat -> Substitution' Term
    expS Nat
    stel = Impossible
    -> [Maybe Term] -> Substitution' Term -> Substitution' Term
    forall a.
    DeBruijn a =>
    Impossible -> [Maybe a] -> Substitution' a -> Substitution' a
    prependS Impossible
    forall a. HasCallStack => a
    __IMPOSSIBLE__
      [ Term -> Maybe Term
    forall a. a -> Maybe a
    Just (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..Nat
    stel] ]
      (Nat -> Substitution' Term
    forall a. Nat -> Substitution' a
    raiseS (Nat
    stel Nat -> Nat -> Nat
    forall a. Num a => a -> a -> a
    + Nat
    1))

    -- * Special cases of Type
    -----------------------------------------------------------

    -- | A @Type@ with sort @Type l@
    --   Such a type supports both hcomp and transp.
    data LType = LEl Level Term deriving (LType -> LType -> Bool
    (LType -> LType -> Bool) -> (LType -> LType -> Bool) -> Eq LType
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: LType -> LType -> Bool
    == :: LType -> LType -> Bool
    $c/= :: LType -> LType -> Bool
    /= :: LType -> LType -> Bool
    Eq,Nat -> LType -> String -> String
    [LType] -> String -> String
    LType -> String
    (Nat -> LType -> String -> String)
    -> (LType -> String) -> ([LType] -> String -> String) -> Show LType
    forall a.
    (Nat -> a -> String -> String)
    -> (a -> String) -> ([a] -> String -> String) -> Show a
    $cshowsPrec :: Nat -> LType -> String -> String
    showsPrec :: Nat -> LType -> String -> String
    $cshow :: LType -> String
    show :: LType -> String
    $cshowList :: [LType] -> String -> String
    showList :: [LType] -> String -> String
    Show)

    fromLType :: LType -> Type
    fromLType :: LType -> Type
    fromLType (LEl Level' Term
    l Term
    t) = Sort -> Term -> Type
    forall t a. Sort' t -> a -> Type'' t a
    El (Level' Term -> Sort
    forall t. Level' t -> Sort' t
    Type Level' Term
    l) Term
    t

    lTypeLevel :: LType -> Level
    lTypeLevel :: LType -> Level' Term
    lTypeLevel (LEl Level' Term
    l Term
    t) = Level' Term
    l

    toLType :: MonadReduce m => Type -> m (Maybe LType)
    toLType :: forall (m :: * -> *). MonadReduce m => Type -> m (Maybe LType)
    toLType Type
    ty = do
      sort <- Sort -> m Sort
    forall a (m :: * -> *). (Reduce a, MonadReduce m) => a -> m a
    reduce (Sort -> m Sort) -> Sort -> m Sort
    forall a b. (a -> b) -> a -> b
    $ Type -> Sort
    forall a. LensSort a => a -> Sort
    getSort Type
    ty
      case sort of
        Type Level' Term
    l -> Maybe LType -> m (Maybe LType)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe LType -> m (Maybe LType)) -> Maybe LType -> m (Maybe LType)
    forall a b. (a -> b) -> a -> b
    $ LType -> Maybe LType
    forall a. a -> Maybe a
    Just (LType -> Maybe LType) -> LType -> Maybe LType
    forall a b. (a -> b) -> a -> b
    $ Level' Term -> Term -> LType
    LEl Level' Term
    l (Type -> Term
    forall t a. Type'' t a -> a
    unEl Type
    ty)
        Sort
    _      -> Maybe LType -> m (Maybe LType)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe LType -> m (Maybe LType)) -> Maybe LType -> m (Maybe LType)
    forall a b. (a -> b) -> a -> b
    $ Maybe LType
    forall a. Maybe a
    Nothing

    instance Subst LType where
      type SubstArg LType = Term
      applySubst :: Substitution' (SubstArg LType) -> LType -> LType
    applySubst Substitution' (SubstArg LType)
    rho (LEl Level' Term
    l Term
    t) = Level' Term -> Term -> LType
    LEl (Substitution' (SubstArg (Level' Term))
    -> Level' Term -> Level' Term
    forall a. Subst a => Substitution' (SubstArg a) -> a -> a
    applySubst Substitution' (SubstArg (Level' Term))
    Substitution' (SubstArg LType)
    rho Level' Term
    l) (Substitution' (SubstArg Term) -> Term -> Term
    forall a. Subst a => Substitution' (SubstArg a) -> a -> a
    applySubst Substitution' (SubstArg Term)
    Substitution' (SubstArg LType)
    rho Term
    t)

    -- | A @Type@ that either has sort @Type l@ or is a closed definition.
    --   Such a type supports some version of transp.
    --   In particular we want to allow the Interval as a @ClosedType@.
    data CType = ClosedType Sort QName | LType LType deriving (CType -> CType -> Bool
    (CType -> CType -> Bool) -> (CType -> CType -> Bool) -> Eq CType
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: CType -> CType -> Bool
    == :: CType -> CType -> Bool
    $c/= :: CType -> CType -> Bool
    /= :: CType -> CType -> Bool
    Eq,Nat -> CType -> String -> String
    [CType] -> String -> String
    CType -> String
    (Nat -> CType -> String -> String)
    -> (CType -> String) -> ([CType] -> String -> String) -> Show CType
    forall a.
    (Nat -> a -> String -> String)
    -> (a -> String) -> ([a] -> String -> String) -> Show a
    $cshowsPrec :: Nat -> CType -> String -> String
    showsPrec :: Nat -> CType -> String -> String
    $cshow :: CType -> String
    show :: CType -> String
    $cshowList :: [CType] -> String -> String
    showList :: [CType] -> String -> String
    Show)

    instance P.Pretty CType where
      pretty :: CType -> Doc
    pretty = Type -> Doc
    forall a. Pretty a => a -> Doc
    P.pretty (Type -> Doc) -> (CType -> Type) -> CType -> Doc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . CType -> Type
    fromCType

    fromCType :: CType -> Type
    fromCType :: CType -> Type
    fromCType (ClosedType Sort
    s QName
    q) = Sort -> Term -> Type
    forall t a. Sort' t -> a -> Type'' t a
    El Sort
    s (QName -> [Elim] -> Term
    Def QName
    q [])
    fromCType (LType LType
    t) = LType -> Type
    fromLType LType
    t

    toCType :: MonadReduce m => Type -> m (Maybe CType)
    toCType :: forall (m :: * -> *). MonadReduce m => Type -> m (Maybe CType)
    toCType Type
    ty = do
      sort <- Sort -> m Sort
    forall a (m :: * -> *). (Reduce a, MonadReduce m) => a -> m a
    reduce (Sort -> m Sort) -> Sort -> m Sort
    forall a b. (a -> b) -> a -> b
    $ Type -> Sort
    forall a. LensSort a => a -> Sort
    getSort Type
    ty
      case sort of
        Type Level' Term
    l -> Maybe CType -> m (Maybe CType)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe CType -> m (Maybe CType)) -> Maybe CType -> m (Maybe CType)
    forall a b. (a -> b) -> a -> b
    $ CType -> Maybe CType
    forall a. a -> Maybe a
    Just (CType -> Maybe CType) -> CType -> Maybe CType
    forall a b. (a -> b) -> a -> b
    $ LType -> CType
    LType (Level' Term -> Term -> LType
    LEl Level' Term
    l (Type -> Term
    forall t a. Type'' t a -> a
    unEl Type
    ty))
        SSet Level' Term
    _ -> do
          t <- Term -> m Term
    forall a (m :: * -> *). (Reduce a, MonadReduce m) => a -> m a
    reduce (Type -> Term
    forall t a. Type'' t a -> a
    unEl Type
    ty)
          case t of
            Def QName
    q [] -> Maybe CType -> m (Maybe CType)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe CType -> m (Maybe CType)) -> Maybe CType -> m (Maybe CType)
    forall a b. (a -> b) -> a -> b
    $ CType -> Maybe CType
    forall a. a -> Maybe a
    Just (CType -> Maybe CType) -> CType -> Maybe CType
    forall a b. (a -> b) -> a -> b
    $ Sort -> QName -> CType
    ClosedType Sort
    sort QName
    q
            Term
    _        -> Maybe CType -> m (Maybe CType)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe CType -> m (Maybe CType)) -> Maybe CType -> m (Maybe CType)
    forall a b. (a -> b) -> a -> b
    $ Maybe CType
    forall a. Maybe a
    Nothing
        Prop Level' Term
    _       -> Maybe CType -> m (Maybe CType)
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe CType
    forall a. Maybe a
    Nothing
        Inf Univ
    _ Integer
    _      -> Maybe CType -> m (Maybe CType)
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe CType
    forall a. Maybe a
    Nothing
        Sort
    IntervalUniv -> Maybe CType -> m (Maybe CType)
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe CType
    forall a. Maybe a
    Nothing  -- ClosedType?  (See comment on CType.)
        Sort
    LevelUniv    -> Maybe CType -> m (Maybe CType)
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe CType
    forall a. Maybe a
    Nothing  -- TODO: Or some ClosedType?
        Sort
    LockUniv     -> Maybe CType -> m (Maybe CType)
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe CType
    forall a. Maybe a
    Nothing
        Sort
    SizeUniv     -> Maybe CType -> m (Maybe CType)
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe CType
    forall a. Maybe a
    Nothing
        PiSort{}     -> Maybe CType -> m (Maybe CType)
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe CType
    forall a. Maybe a
    Nothing
        FunSort{}    -> Maybe CType -> m (Maybe CType)
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe CType
    forall a. Maybe a
    Nothing
        UnivSort{}   -> Maybe CType -> m (Maybe CType)
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe CType
    forall a. Maybe a
    Nothing
        MetaS{}      -> Maybe CType -> m (Maybe CType)
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe CType
    forall a. Maybe a
    Nothing
        DefS{}       -> Maybe CType -> m (Maybe CType)
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe CType
    forall a. Maybe a
    Nothing
        DummyS{}     -> Maybe CType -> m (Maybe CType)
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe CType
    forall a. Maybe a
    Nothing

    instance Subst CType where
      type SubstArg CType = Term
      applySubst :: Substitution' (SubstArg CType) -> CType -> CType
    applySubst Substitution' (SubstArg CType)
    rho (ClosedType Sort
    s QName
    q) = Sort -> QName -> CType
    ClosedType (Substitution' (SubstArg Sort) -> Sort -> Sort
    forall a. Subst a => Substitution' (SubstArg a) -> a -> a
    applySubst Substitution' (SubstArg Sort)
    Substitution' (SubstArg CType)
    rho Sort
    s) QName
    q
      applySubst Substitution' (SubstArg CType)
    rho (LType LType
    t) = LType -> CType
    LType (LType -> CType) -> LType -> CType
    forall a b. (a -> b) -> a -> b
    $ Substitution' (SubstArg LType) -> LType -> LType
    forall a. Subst a => Substitution' (SubstArg a) -> a -> a
    applySubst Substitution' (SubstArg CType)
    Substitution' (SubstArg LType)
    rho LType
    t

    hcomp :: (HasBuiltins m, MonadError TCErr m, MonadReduce m, MonadPretty m)
      => NamesT m Type
      -> [(NamesT m Term, NamesT m Term)]
      -> NamesT m Term
      -> NamesT m Term
    hcomp :: forall (m :: * -> *).
    (HasBuiltins m, MonadError TCErr m, MonadReduce m,
     MonadPretty m) =>
    NamesT m Type
    -> [(NamesT m Term, NamesT m Term)]
    -> NamesT m Term
    -> NamesT m Term
    hcomp NamesT m Type
    ty [(NamesT m Term, NamesT m Term)]
    sys NamesT m Term
    u0 = do
      iz <- NamesT m Term
    forall (m :: * -> *).
    (HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
    m Term
    primIZero
      tHComp <- primHComp
      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
      ty <- ty
      (l, ty) <- toLType ty >>= \case
        Just (LEl Level' Term
    l Term
    ty) -> (Level' Term, Term) -> NamesT m (Level' Term, Term)
    forall a. a -> NamesT m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Level' Term
    l, Term
    ty)
        Maybe LType
    Nothing -> -- TODO: support Setω properly
          TypeError -> NamesT m (Level' Term, Term)
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCError m) =>
    TypeError -> m a
    typeError (TypeError -> NamesT m (Level' Term, Term))
    -> TypeError -> NamesT m (Level' Term, Term)
    forall a b. (a -> b) -> a -> b
    $ Type -> TypeError
    CannotGenerateHCompClause Type
    ty
      l <- open $ Level l
      ty <- open $ ty
      face <- (foldr max (pure iz) $ map fst $ sys)
      sys <- lam "i'" $ \ NamesT m Term
    i -> NamesT m Term
    -> NamesT m Term
    -> [(NamesT m Term, NamesT m Term)]
    -> NamesT m Term
    forall (m :: * -> *).
    HasBuiltins m =>
    NamesT m Term
    -> NamesT m Term
    -> [(NamesT m Term, NamesT m Term)]
    -> NamesT m Term
    combineSys NamesT m Term
    l NamesT m Term
    ty [(NamesT m Term
    phi, NamesT m Term
    u 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
    phi,NamesT m Term
    u) <- [(NamesT m Term, NamesT m Term)]
    sys]
      pure tHComp <#> l <#> ty <#> pure face <@> pure sys <@> u0

    transpSys :: (HasBuiltins m, MonadError TCErr m, MonadReduce m) =>
                   NamesT m (Abs Type) -- ty
                   -> [(NamesT m Term, NamesT m Term)] -- sys
                   -> NamesT m Term -- φ
                   -> NamesT m Term
                   -> NamesT m Term
    transpSys :: forall (m :: * -> *).
    (HasBuiltins m, MonadError TCErr m, MonadReduce m) =>
    NamesT m (Abs Type)
    -> [(NamesT m Term, NamesT m Term)]
    -> NamesT m Term
    -> NamesT m Term
    -> NamesT m Term
    transpSys NamesT m (Abs Type)
    ty [(NamesT m Term, NamesT m Term)]
    sys NamesT m Term
    phi NamesT m Term
    u = do
      let max :: NamesT m Term -> NamesT m Term -> NamesT m Term
    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
      iz <- NamesT m Term
    forall (m :: * -> *).
    (HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
    m Term
    primIZero
      tTransp <- primTrans
      tComp <- fromMaybe __IMPOSSIBLE__ <$> getTerm' builtinComp
      l_ty <- bind "i" $ \ forall b. (Subst b, DeBruijn b) => NamesT m b
    i -> do
          ty <- Abs Type -> Term -> Type
    Abs Type -> SubstArg Type -> Type
    forall a. Subst a => Abs a -> SubstArg a -> a
    absApp (Abs Type -> Term -> Type)
    -> NamesT m (Abs Type) -> NamesT m (Term -> Type)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> NamesT m (Abs Type)
    ty NamesT m (Term -> Type) -> NamesT m Term -> NamesT m Type
    forall a b. NamesT m (a -> b) -> NamesT m a -> NamesT m b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> NamesT m Term
    forall b. (Subst b, DeBruijn b) => NamesT m b
    i
          toLType ty >>= \case
            Just (LEl Level' Term
    l Term
    ty) -> (Level' Term, Term) -> NamesT m (Level' Term, Term)
    forall a. a -> NamesT m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Level' Term
    l,Term
    ty)
            Maybe LType
    Nothing -> (Level' Term, Term) -> NamesT m (Level' Term, Term)
    forall a. a -> NamesT m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Level' Term
    HasCallStack => Level' Term
    __DUMMY_LEVEL__, Type -> Term
    forall t a. Type'' t a -> a
    unEl Type
    ty) -- TODO: properly support Setω
      l <- open $ Lam defaultArgInfo . fmap (Level . fst) $ l_ty
      ty <- open $ Lam defaultArgInfo . fmap snd $ l_ty

      if null sys then pure tTransp <#> l <@> ty <@> phi <@> u else do

      let face = NamesT m Term -> NamesT m Term -> NamesT m Term
    forall {m :: * -> *}.
    (HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
    NamesT m Term -> NamesT m Term -> NamesT m Term
    max NamesT m Term
    phi ((NamesT m Term -> NamesT m Term -> NamesT m Term)
    -> NamesT m Term -> [NamesT m Term] -> NamesT m Term
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr NamesT m Term -> NamesT m Term -> NamesT m Term
    forall {m :: * -> *}.
    (HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
    NamesT m Term -> NamesT m Term -> NamesT m Term
    max (Term -> NamesT m Term
    forall a. a -> NamesT m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Term
    iz) ([NamesT m Term] -> NamesT m Term)
    -> [NamesT m Term] -> NamesT m Term
    forall a b. (a -> b) -> a -> b
    $ ((NamesT m Term, NamesT m Term) -> NamesT m Term)
    -> [(NamesT m Term, NamesT m Term)] -> [NamesT m Term]
    forall a b. (a -> b) -> [a] -> [b]
    map (NamesT m Term, NamesT m Term) -> NamesT m Term
    forall a b. (a, b) -> a
    fst ([(NamesT m Term, NamesT m Term)] -> [NamesT m Term])
    -> [(NamesT m Term, NamesT m Term)] -> [NamesT m Term]
    forall a b. (a -> b) -> a -> b
    $ [(NamesT m Term, NamesT m Term)]
    sys)
      sys <- (open =<<) $ lam "i'" $ \ NamesT m Term
    i -> do
        let base :: (NamesT m Term, NamesT m Term)
    base = (NamesT m Term
    phi, String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
    forall (m :: * -> *).
    Monad m =>
    String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
    ilam String
    "o" ((NamesT m Term -> NamesT m Term) -> NamesT m Term)
    -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
    forall a b. (a -> b) -> a -> b
    $ \ NamesT m Term
    _ -> NamesT m Term
    u)
        NamesT m Term
    -> NamesT m Term
    -> [(NamesT m Term, NamesT m Term)]
    -> NamesT m Term
    forall (m :: * -> *).
    HasBuiltins m =>
    NamesT m Term
    -> NamesT m Term
    -> [(NamesT m Term, NamesT m Term)]
    -> NamesT m Term
    combineSys NamesT m Term
    l NamesT m Term
    ty ([(NamesT m Term, NamesT m Term)] -> NamesT m Term)
    -> [(NamesT m Term, NamesT m Term)] -> NamesT m Term
    forall a b. (a -> b) -> a -> b
    $ (NamesT m Term, NamesT m Term)
    base (NamesT m Term, NamesT m Term)
    -> [(NamesT m Term, NamesT m Term)]
    -> [(NamesT m Term, NamesT m Term)]
    forall a. a -> [a] -> [a]
    : [(NamesT m Term
    phi, NamesT m Term
    u 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
    phi,NamesT m Term
    u) <- [(NamesT m Term, NamesT m Term)]
    sys]

      pure tComp <#> l <@> ty <#> face <@> sys <@> u

    debugClause :: String -> Clause -> TCM ()
    debugClause :: String -> Clause -> TCM ()
    debugClause String
    s Clause
    c = do
          String -> Nat -> TCMT IO Doc -> TCM ()
    forall (m :: * -> *).
    MonadDebug m =>
    String -> Nat -> TCMT IO Doc -> m ()
    reportSDoc String
    s Nat
    20 (TCMT IO Doc -> TCM ()) -> TCMT IO Doc -> TCM ()
    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
    <+> Telescope -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    forall (m :: * -> *). MonadPretty m => Telescope -> m Doc
    prettyTCM Telescope
    gamma
          String -> Nat -> TCMT IO Doc -> TCM ()
    forall (m :: * -> *).
    MonadDebug m =>
    String -> Nat -> TCMT IO Doc -> m ()
    reportSDoc String
    s Nat
    20 (TCMT IO Doc -> TCM ()) -> TCMT IO Doc -> TCM ()
    forall a b. (a -> b) -> a -> b
    $ Telescope -> TCMT IO Doc -> TCMT IO Doc
    forall b (m :: * -> *) a.
    (AddContext b, MonadAddContext m) =>
    b -> m a -> m a
    forall (m :: * -> *) a.
    MonadAddContext m =>
    Telescope -> m a -> m a
    addContext Telescope
    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] -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    forall (m :: * -> *). MonadPretty m => [Elim] -> m Doc
    prettyTCM ([NamedArg DeBruijnPattern] -> [Elim]
    patternsToElims [NamedArg DeBruijnPattern]
    ps)
          String -> Nat -> TCMT IO Doc -> TCM ()
    forall (m :: * -> *).
    MonadDebug m =>
    String -> Nat -> TCMT IO Doc -> m ()
    reportSDoc String
    s Nat
    20 (TCMT IO Doc -> TCM ()) -> TCMT IO Doc -> TCM ()
    forall a b. (a -> b) -> a -> b
    $ Telescope -> TCMT IO Doc -> TCMT IO Doc
    forall b (m :: * -> *) a.
    (AddContext b, MonadAddContext m) =>
    b -> m a -> m a
    forall (m :: * -> *) a.
    MonadAddContext m =>
    Telescope -> m a -> m a
    addContext Telescope
    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
    <+> TCMT IO Doc
    -> (Arg Type -> TCMT IO Doc) -> Maybe (Arg Type) -> TCMT IO Doc
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe TCMT IO Doc
    "nothing" Arg Type -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    forall (m :: * -> *). MonadPretty m => Arg Type -> m Doc
    prettyTCM Maybe (Arg Type)
    rhsTy
          String -> Nat -> TCMT IO Doc -> TCM ()
    forall (m :: * -> *).
    MonadDebug m =>
    String -> Nat -> TCMT IO Doc -> m ()
    reportSDoc String
    s Nat
    20 (TCMT IO Doc -> TCM ()) -> TCMT IO Doc -> TCM ()
    forall a b. (a -> b) -> a -> b
    $ Telescope -> TCMT IO Doc -> TCMT IO Doc
    forall b (m :: * -> *) a.
    (AddContext b, MonadAddContext m) =>
    b -> m a -> m a
    forall (m :: * -> *) a.
    MonadAddContext m =>
    Telescope -> m a -> m a
    addContext Telescope
    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
    <+> TCMT IO Doc -> (Term -> TCMT IO Doc) -> Maybe Term -> TCMT IO Doc
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe TCMT IO Doc
    "nothing" Term -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    forall (m :: * -> *). MonadPretty m => Term -> m Doc
    prettyTCM Maybe Term
    rhs

          String -> Nat -> TCMT IO Doc -> TCM ()
    forall (m :: * -> *).
    MonadDebug m =>
    String -> Nat -> TCMT IO Doc -> m ()
    reportSDoc String
    s Nat
    30 (TCMT IO Doc -> TCM ()) -> TCMT IO Doc -> TCM ()
    forall a b. (a -> b) -> a -> b
    $
            Telescope -> TCMT IO Doc -> TCMT IO Doc
    forall b (m :: * -> *) a.
    (AddContext b, MonadAddContext m) =>
    b -> m a -> m a
    forall (m :: * -> *) a.
    MonadAddContext m =>
    Telescope -> m a -> m a
    addContext Telescope
    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
      where
        gamma :: Telescope
    gamma = Clause -> Telescope
    clauseTel Clause
    c
        ps :: [NamedArg DeBruijnPattern]
    ps = Clause -> [NamedArg DeBruijnPattern]
    namedClausePats Clause
    c
        rhsTy :: Maybe (Arg Type)
    rhsTy = Clause -> Maybe (Arg Type)
    clauseType Clause
    c
        rhs :: Maybe Term
    rhs = Clause -> Maybe Term
    clauseBody Clause
    c