{-# LANGUAGE NondecreasingIndentation #-}

module Mikan.TypeChecking.Coverage.Cubical where

import Prelude hiding (null, (!!))  -- do not use partial functions like !!

import Control.Monad.Except ( runExceptT )
import Control.Monad.Error.Class

import Data.Set qualified as Set
import Data.IntSet (IntSet)
import Data.IntSet qualified as IntSet
import Data.Text.Short (ShortText)

import Mikan.Syntax.Common hiding (DataOrRecord)
import Mikan.Syntax.Position
import Mikan.Syntax.Internal
import Mikan.Syntax.Common.Pretty (prettyShow)

import Mikan.TypeChecking.Constraints () -- instance MonadConstraint TCM
import Mikan.TypeChecking.Coverage.Errors
import Mikan.TypeChecking.Coverage.Match
import Mikan.TypeChecking.Coverage.SplitClause
import Mikan.TypeChecking.Coverage.SplitPattern
import Mikan.TypeChecking.Coverage.SplitTree
import Mikan.TypeChecking.Datatypes (getDatatypeArgs)
import Mikan.TypeChecking.Irrelevance
import Mikan.TypeChecking.Monad
import Mikan.TypeChecking.Names
import Mikan.TypeChecking.Pretty
import Mikan.TypeChecking.Primitive hiding (Nat)
import Mikan.TypeChecking.Reduce
import Mikan.TypeChecking.Substitute
import Mikan.TypeChecking.Telescope
import Mikan.TypeChecking.Telescope.Path

import Mikan.Utils.Either ( fromRight )
import Mikan.Utils.Functor
import Mikan.Utils.List
import Mikan.Utils.List1 ( pattern (:|) )
import Mikan.Utils.List1 qualified as List1
import Mikan.Utils.Maybe
import Mikan.Utils.Monad
import Mikan.Utils.Null
import Mikan.Utils.Permutation
import Mikan.Utils.Singleton
import Mikan.Utils.Size

import Mikan.Utils.Impossible


createMissingIndexedClauses ::
     QName
  -> Arg Nat
  -> BlockingVar
  -> SplitClause
  -> [(SplitTag,(SplitClause,IInfo))]
  -> [Clause]
  -> TCM ([(SplitTag,CoverResult)],[Clause])
createMissingIndexedClauses :: QName
-> Arg Int
-> BlockingVar
-> SplitClause
-> [(SplitTag, (SplitClause, IInfo))]
-> [Clause]
-> TCM ([(SplitTag, CoverResult)], [Clause])
createMissingIndexedClauses QName
f Arg Int
n BlockingVar
x SplitClause
old_sc [(SplitTag, (SplitClause, IInfo))]
scs [Clause]
cs = do
  let infos :: [(QName, UnifyEquiv)]
infos = [(QName
c,UnifyEquiv
i) | (SplitCon QName
c, (SplitClause
_,TheInfo UnifyEquiv
i)) <- [(SplitTag, (SplitClause, IInfo))]
scs ]

  case [(QName, UnifyEquiv)]
infos of
    (QName, UnifyEquiv)
info:[(QName, UnifyEquiv)]
_ -> do
      VerboseKey -> Int -> TCMT IO Doc -> TCMT IO ()
forall (m :: * -> *).
MonadDebug m =>
VerboseKey -> Int -> TCMT IO Doc -> m ()
reportSDoc VerboseKey
"tc.cover.indexed" Int
20 (TCMT IO Doc -> TCMT IO ()) -> TCMT IO Doc -> TCMT IO ()
forall a b. (a -> b) -> a -> b
$ VerboseKey -> TCMT IO Doc
forall (m :: * -> *). Applicative m => VerboseKey -> m Doc
text VerboseKey
"size (xs,infos):" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> (Int, Int) -> TCMT IO Doc
forall (m :: * -> *) a. (Applicative m, Pretty a) => a -> m Doc
pretty ([(SplitTag, (SplitClause, IInfo))] -> Int
forall a. Sized a => a -> Int
size [(SplitTag, (SplitClause, IInfo))]
scs,[(QName, UnifyEquiv)] -> Int
forall a. Sized a => a -> Int
size [(QName, UnifyEquiv)]
infos)
      VerboseKey -> Int -> TCMT IO Doc -> TCMT IO ()
forall (m :: * -> *).
MonadDebug m =>
VerboseKey -> Int -> TCMT IO Doc -> m ()
reportSDoc VerboseKey
"tc.cover.indexed" Int
20 (TCMT IO Doc -> TCMT IO ()) -> TCMT IO Doc -> TCMT IO ()
forall a b. (a -> b) -> a -> b
$ VerboseKey -> TCMT IO Doc
forall (m :: * -> *). Applicative m => VerboseKey -> m Doc
text VerboseKey
"xs :" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> [SplitTag] -> TCMT IO Doc
forall (m :: * -> *) a. (Applicative m, Pretty a) => a -> m Doc
pretty (((SplitTag, (SplitClause, IInfo)) -> SplitTag)
-> [(SplitTag, (SplitClause, IInfo))] -> [SplitTag]
forall a b. (a -> b) -> [a] -> [b]
map (SplitTag, (SplitClause, IInfo)) -> SplitTag
forall a b. (a, b) -> a
fst [(SplitTag, (SplitClause, IInfo))]
scs)

      Bool -> TCMT IO () -> TCMT IO ()
forall b (m :: * -> *). (IsBool b, Monad m) => b -> m () -> m ()
unless ([(SplitTag, (SplitClause, IInfo))] -> Int
forall a. Sized a => a -> Int
size [(SplitTag, (SplitClause, IInfo))]
scs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [(QName, UnifyEquiv)] -> Int
forall a. Sized a => a -> Int
size [(QName, UnifyEquiv)]
infos) (TCMT IO () -> TCMT IO ()) -> TCMT IO () -> TCMT IO ()
forall a b. (a -> b) -> a -> b
$
        VerboseKey -> Int -> TCMT IO Doc -> TCMT IO ()
forall (m :: * -> *).
MonadDebug m =>
VerboseKey -> Int -> TCMT IO Doc -> m ()
reportSDoc VerboseKey
"tc.cover.indexed" Int
20 (TCMT IO Doc -> TCMT IO ()) -> TCMT IO Doc -> TCMT IO ()
forall a b. (a -> b) -> a -> b
$ VerboseKey -> TCMT IO Doc
forall (m :: * -> *). Applicative m => VerboseKey -> m Doc
text VerboseKey
"missing some infos"
        -- Andrea: what to do when we only managed to build a unification proof for some of the constructors?

      Constructor{conData} <- Definition -> Defn
theDef (Definition -> Defn) -> TCMT IO Definition -> TCMT IO Defn
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> QName -> TCMT IO Definition
forall (m :: * -> *).
(HasConstInfo m, HasCallStack) =>
QName -> m Definition
getConstInfo ((QName, UnifyEquiv) -> QName
forall a b. (a, b) -> a
fst (QName, UnifyEquiv)
info)
      Datatype{dataPars = pars, dataIxs = nixs, dataTranspIx} <- theDef <$> getConstInfo conData

      hcomp <- fromMaybe __IMPOSSIBLE__ <$> getName' builtinHComp
      trX <- fromMaybe __IMPOSSIBLE__ <$> pure dataTranspIx

      trX_cl   <- createMissingTrXTrXClause trX f n x old_sc
      hcomp_cl <- createMissingTrXHCompClause trX f n x old_sc

      (trees,cls) <- fmap unzip . forM infos $ \(QName
c, UnifyEquiv
i) -> do
        cl <- QName
-> QName
-> Arg Int
-> BlockingVar
-> SplitClause
-> QName
-> UnifyEquiv
-> TCM Clause
createMissingTrXConClause QName
trX QName
f Arg Int
n BlockingVar
x SplitClause
old_sc QName
c UnifyEquiv
i
        return $ ((SplitCon c , SplittingDone (size $ clauseTel cl)) , cl)

      let
        extra =
          [ (QName -> SplitTag
SplitCon QName
trX, Int -> SplitTree' SplitTag
forall a. Int -> SplitTree' a
SplittingDone (Int -> SplitTree' SplitTag) -> Int -> SplitTree' SplitTag
forall a b. (a -> b) -> a -> b
$ Telescope -> Int
forall a. Sized a => a -> Int
size (Telescope -> Int) -> Telescope -> Int
forall a b. (a -> b) -> a -> b
$ Clause -> Telescope
clauseTel Clause
trX_cl)
          , (QName -> SplitTag
SplitCon QName
hcomp, Int -> SplitTree' SplitTag
forall a. Int -> SplitTree' a
SplittingDone (Int -> SplitTree' SplitTag) -> Int -> SplitTree' SplitTag
forall a b. (a -> b) -> a -> b
$ Telescope -> Int
forall a. Sized a => a -> Int
size (Telescope -> Int) -> Telescope -> Int
forall a b. (a -> b) -> a -> b
$ Clause -> Telescope
clauseTel Clause
hcomp_cl)
          ]
        extraCl = [ Clause
trX_cl, Clause
hcomp_cl ]
              --  = [trX_cl]
        clauses = [Clause]
cls [Clause] -> [Clause] -> [Clause]
forall a. [a] -> [a] -> [a]
++ [Clause]
extraCl
        tree = Arg Int
-> LazySplit
-> [(SplitTag, SplitTree' SplitTag)]
-> SplitTree' SplitTag
forall a. Arg Int -> LazySplit -> SplitTrees' a -> SplitTree' a
SplitAt (Arg Int
n Arg Int -> (Int -> Int) -> Arg Int
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
pars Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
nixs Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1))) LazySplit
StrictSplit ([(SplitTag, SplitTree' SplitTag)] -> SplitTree' SplitTag)
-> [(SplitTag, SplitTree' SplitTag)] -> SplitTree' SplitTag
forall a b. (a -> b) -> a -> b
$ [(SplitTag, SplitTree' SplitTag)]
trees [(SplitTag, SplitTree' SplitTag)]
-> [(SplitTag, SplitTree' SplitTag)]
-> [(SplitTag, SplitTree' SplitTag)]
forall a. [a] -> [a] -> [a]
++ [(SplitTag, SplitTree' SplitTag)]
extra
        res = CoverResult
          { coverSplitTree :: SplitTree' SplitTag
coverSplitTree      = SplitTree' SplitTag
tree
          , coverUsedClauses :: IntSet
coverUsedClauses    = let l :: Int
l = [Clause] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Clause]
cs in [Int] -> IntSet
IntSet.fromAscList [Int
l .. Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [Clause] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Clause]
clauses Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]
          , coverMissingClauses :: [(Telescope, [NamedArg DeBruijnPattern])]
coverMissingClauses = []
          , coverPatterns :: [Clause]
coverPatterns       = [Clause]
clauses
          , coverNoExactClauses :: IntSet
coverNoExactClauses = IntSet
IntSet.empty
          }
      reportSDoc "tc.cover.indexed" 20 $ "tree:" <+> pretty tree
      addClauses f clauses
      return ([(SplitCon trX, res)], cs ++ clauses)
    [(QName, UnifyEquiv)]
_ -> ([(SplitTag, CoverResult)], [Clause])
-> TCM ([(SplitTag, CoverResult)], [Clause])
forall a. a -> TCMT IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([], [Clause]
cs)

covFillTele :: QName -> Abs Telescope -> Term -> Args -> Term -> TCM [Term]
covFillTele :: QName -> Abs Telescope -> Term -> Args -> Term -> TCM [Term]
covFillTele QName
func Abs Telescope
tel Term
face Args
d Term
j = do
  ed_f <- TCM (Either (Closure (Abs Type)) Args)
-> TCM (Either (Closure (Abs Type)) Args)
forall a. TCM a -> TCM a
forall (tcm :: * -> *) a. MonadTCM tcm => TCM a -> tcm a
liftTCM (TCM (Either (Closure (Abs Type)) Args)
 -> TCM (Either (Closure (Abs Type)) Args))
-> TCM (Either (Closure (Abs Type)) Args)
-> TCM (Either (Closure (Abs Type)) Args)
forall a b. (a -> b) -> a -> b
$ ExceptT (Closure (Abs Type)) (TCMT IO) Args
-> TCM (Either (Closure (Abs Type)) Args)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT (Closure (Abs Type)) (TCMT IO) Args
 -> TCM (Either (Closure (Abs Type)) Args))
-> ExceptT (Closure (Abs Type)) (TCMT IO) Args
-> TCM (Either (Closure (Abs Type)) Args)
forall a b. (a -> b) -> a -> b
$ Abs Telescope
-> Term
-> Args
-> Term
-> ExceptT (Closure (Abs Type)) (TCMT IO) Args
trFillTel Abs Telescope
tel Term
face Args
d Term
j
  case ed_f of
    Right Args
d_f -> [Term] -> TCM [Term]
forall a. a -> TCMT IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Term] -> TCM [Term]) -> [Term] -> TCM [Term]
forall a b. (a -> b) -> a -> b
$ (Arg Term -> Term) -> Args -> [Term]
forall a b. (a -> b) -> [a] -> [b]
map Arg Term -> Term
forall e. Arg e -> e
unArg Args
d_f
    Left Closure (Abs Type)
failed_t -> TypeError -> TCM [Term]
forall (m :: * -> *) e a.
(HasCallStack, MonadTCError m, Diagnostic e) =>
e -> m a
typeError (TypeError -> TCM [Term]) -> TypeError -> TCM [Term]
forall a b. (a -> b) -> a -> b
$ QName -> Closure (Abs Type) -> TypeError
CannotGenerateTransportClause QName
func Closure (Abs Type)
failed_t

createMissingTrXTrXClause ::
     QName -- ^ trX
  -> QName -- ^ f defined
  -> Arg Nat
  -> BlockingVar
  -> SplitClause
  -> TCM Clause
createMissingTrXTrXClause :: QName
-> QName -> Arg Int -> BlockingVar -> SplitClause -> TCM Clause
createMissingTrXTrXClause QName
q_trX QName
f Arg Int
n BlockingVar
x SplitClause
old_sc = do
  let
    old_tel :: Telescope
old_tel = SplitClause -> Telescope
scTel SplitClause
old_sc
    old_ps :: [NamedArg DeBruijnPattern]
old_ps = [NamedArg SplitPattern] -> [NamedArg DeBruijnPattern]
fromSplitPatterns ([NamedArg SplitPattern] -> [NamedArg DeBruijnPattern])
-> [NamedArg SplitPattern] -> [NamedArg DeBruijnPattern]
forall a b. (a -> b) -> a -> b
$ SplitClause -> [NamedArg SplitPattern]
scPats SplitClause
old_sc
    old_t :: Dom Type
old_t = Dom Type -> Maybe (Dom Type) -> Dom Type
forall a. a -> Maybe a -> a
fromMaybe Dom Type
forall a. HasCallStack => a
__IMPOSSIBLE__ (Maybe (Dom Type) -> Dom Type) -> Maybe (Dom Type) -> Dom Type
forall a b. (a -> b) -> a -> b
$ SplitClause -> Maybe (Dom Type)
scTarget SplitClause
old_sc

  VerboseKey -> Int -> TCMT IO Doc -> TCMT IO ()
forall (m :: * -> *).
MonadDebug m =>
VerboseKey -> Int -> TCMT IO Doc -> m ()
reportSDoc VerboseKey
"tc.cover.trx.trx" Int
20 (TCMT IO Doc -> TCMT IO ()) -> TCMT IO Doc -> TCMT IO ()
forall a b. (a -> b) -> a -> b
$ TCMT IO Doc
"trX-trX clause for" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> QName -> TCMT IO Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
forall (m :: * -> *). MonadPretty m => QName -> m Doc
prettyTCM QName
f
  VerboseKey -> Int -> TCMT IO Doc -> TCMT IO ()
forall (m :: * -> *).
MonadDebug m =>
VerboseKey -> Int -> TCMT IO Doc -> m ()
reportSDoc VerboseKey
"tc.cover.trx.trx" Int
20 (TCMT IO Doc -> TCMT IO ()) -> TCMT IO Doc -> TCMT IO ()
forall a b. (a -> b) -> a -> b
$ Int -> TCMT IO Doc -> TCMT IO Doc
forall (m :: * -> *). Functor m => Int -> m Doc -> m Doc
nest Int
2 (TCMT IO Doc -> TCMT IO Doc) -> TCMT IO Doc -> TCMT IO Doc
forall a b. (a -> b) -> a -> b
$ [TCMT IO Doc] -> TCMT IO Doc
forall (m :: * -> *) (t :: * -> *).
(Applicative m, Foldable t) =>
t (m Doc) -> m Doc
vcat ([TCMT IO Doc] -> TCMT IO Doc) -> [TCMT IO Doc] -> TCMT IO Doc
forall a b. (a -> b) -> a -> b
$
    [ TCMT IO Doc
"old_tel:" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> Telescope -> TCMT IO Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
forall (m :: * -> *). MonadPretty m => Telescope -> m Doc
prettyTCM Telescope
old_tel
    , TCMT IO Doc
"old_ps :" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> Telescope -> TCMT IO Doc -> TCMT IO Doc
forall b (m :: * -> *) a.
(AddContext b, MonadAddContext m) =>
b -> m a -> m a
forall (m :: * -> *) a.
MonadAddContext m =>
Telescope -> m a -> m a
addContext Telescope
old_tel ([Elim] -> TCMT IO Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
forall (m :: * -> *). MonadPretty m => [Elim] -> m Doc
prettyTCM ([Elim] -> TCMT IO Doc) -> [Elim] -> TCMT IO Doc
forall a b. (a -> b) -> a -> b
$ [NamedArg DeBruijnPattern] -> [Elim]
patternsToElims [NamedArg DeBruijnPattern]
old_ps)
    , TCMT IO Doc
"old_t  :" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> Telescope -> TCMT IO Doc -> TCMT IO Doc
forall b (m :: * -> *) a.
(AddContext b, MonadAddContext m) =>
b -> m a -> m a
forall (m :: * -> *) a.
MonadAddContext m =>
Telescope -> m a -> m a
addContext Telescope
old_tel (Dom Type -> TCMT IO Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
forall (m :: * -> *). MonadPretty m => Dom Type -> m Doc
prettyTCM Dom Type
old_t)
    ]

  -- TODO: redo comments, the strategy changed.
  -- old_tel = Γ1, (x : D η v), Δ
  -- α = boundary(old_ps)
  -- Γ1, (x : D η v), Δ ⊢ f old_ps : old_t [ α ↦ (f old_ps)[α] ]

  -- α' = boundary(old_ps[x = pat])
  -- Γ1, φ : I, p : Path X(η) _ v, ψ : I, q : Path X(η) _ (p i0), x0 : D η (q i0) ⊢ pat := trX p φ (trX q ψ x0) : D η v

  -- Ξ = Γ1, φ : I, p : Path X(η) _ v, ψ : I, q : Path X(η) _ (p i0), x0 : D η (q i0), Δ[x = pat]

  -- Ξ ⊢ w1 := f old_ps[γ1,x = pat,δ] : old_t[γ1,x = pat,δ] -- the case we are defining. can only be used if specialized.

  -- Ξ ⊢ rhs : old_t[γ1,x = pat,δ] [ α' ↦ w1[α']
                                -- , φ  ↦ w1[φ = i1, p = refl]
                                -- , ψ  ↦ w1[ψ = i1, q = refl]
                                -- ]
  -- Ξ ⊢ q2 := tr (i. Path X(η) (q i0) (p i)) φ q : Path X(η) (q i0) (p i1)
  -- Ξ ⊢ pat_rec[0] = pat : D η v
  -- Ξ ⊢ pat_rec[1] = trX q2 (φ ∧ ψ) x0 : D η v
  -- Ξ ⊢ pat-rec[i] := trX (\ j → p (i ∨ j)) (i ∨ φ) (trX (q2_f i) (ψ ∧ (φ ∨ ~ i)) t)

  -- Ξ ⊢ δ_f[1] = tr (i. Δ[γ1,x = pat_rec[i]]) (φ ∧ ψ) δ
  -- Ξ ⊢ w0 := f old_ps[γ1,x = pat_rec[1] ,δ_f[1]] : old_t[γ1,x = pat_rec[1],δ_f[1]]
  -- Ξ ⊢ rhs := tr (i. old_t[γ1,x = pat_rec[~i], δ_f[~i]]) (φ ∧ ψ) w0 -- TODO plus sides.

  interval <- TCMT IO Type
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Type
primIntervalType
  iz <- primIZero
  io <- primIOne
  tHComp <- primHComp
  tNeg <- primINeg
  let neg NamesT (TCMT IO) Term
i = Term -> NamesT (TCMT IO) Term
forall a. a -> NamesT (TCMT IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
tNeg 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
  let min NamesT m Term
i NamesT m Term
j = m Term -> NamesT m Term
forall (m :: * -> *) a. Monad m => m a -> NamesT m a
cl m Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primIMin NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT m Term
i NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT m Term
j
  let max NamesT m Term
i NamesT m Term
j = m Term -> NamesT m Term
forall (m :: * -> *) a. Monad m => m a -> NamesT m a
cl m Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primIMax NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT m Term
i NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT m Term
j
  let
    old_ps' = [ShortText]
-> [NamedArg DeBruijnPattern] -> AbsN [NamedArg DeBruijnPattern]
forall a. [ShortText] -> a -> AbsN a
AbsN (Telescope -> [ShortText]
teleNames Telescope
old_tel) ([NamedArg DeBruijnPattern] -> AbsN [NamedArg DeBruijnPattern])
-> [NamedArg DeBruijnPattern] -> AbsN [NamedArg DeBruijnPattern]
forall a b. (a -> b) -> a -> b
$ [NamedArg SplitPattern] -> [NamedArg DeBruijnPattern]
fromSplitPatterns ([NamedArg SplitPattern] -> [NamedArg DeBruijnPattern])
-> [NamedArg SplitPattern] -> [NamedArg DeBruijnPattern]
forall a b. (a -> b) -> a -> b
$ SplitClause -> [NamedArg SplitPattern]
scPats SplitClause
old_sc
    old_ps = AbsN [NamedArg DeBruijnPattern]
-> NamesT (TCMT IO) (AbsN [NamedArg DeBruijnPattern])
forall a. a -> NamesT (TCMT IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AbsN [NamedArg DeBruijnPattern]
 -> NamesT (TCMT IO) (AbsN [NamedArg DeBruijnPattern]))
-> AbsN [NamedArg DeBruijnPattern]
-> NamesT (TCMT IO) (AbsN [NamedArg DeBruijnPattern])
forall a b. (a -> b) -> a -> b
$ AbsN [NamedArg DeBruijnPattern]
old_ps'
    old_ty = AbsN (Dom Type) -> NamesT (TCMT IO) (AbsN (Dom Type))
forall a. a -> NamesT (TCMT IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AbsN (Dom Type) -> NamesT (TCMT IO) (AbsN (Dom Type)))
-> AbsN (Dom Type) -> NamesT (TCMT IO) (AbsN (Dom Type))
forall a b. (a -> b) -> a -> b
$ [ShortText] -> Dom Type -> AbsN (Dom Type)
forall a. [ShortText] -> a -> AbsN a
AbsN (Telescope -> [ShortText]
teleNames Telescope
old_tel) (Dom Type -> AbsN (Dom Type)) -> Dom Type -> AbsN (Dom Type)
forall a b. (a -> b) -> a -> b
$ Dom Type -> Maybe (Dom Type) -> Dom Type
forall a. a -> Maybe a -> a
fromMaybe Dom Type
forall a. HasCallStack => a
__IMPOSSIBLE__ (Maybe (Dom Type) -> Dom Type) -> Maybe (Dom Type) -> Dom Type
forall a b. (a -> b) -> a -> b
$ SplitClause -> Maybe (Dom Type)
scTarget SplitClause
old_sc
  -- old_tel = Γ(x: D η v)Δ
  -- Γ1, (x : D η v)  ⊢ delta = (δ : Δ)
    (gamma1x,delta') = splitTelescopeAt (size old_tel - blockingVarNo x) old_tel
    delta = AbsN Telescope -> NamesT (TCMT IO) (AbsN Telescope)
forall a. a -> NamesT (TCMT IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AbsN Telescope -> NamesT (TCMT IO) (AbsN Telescope))
-> AbsN Telescope -> NamesT (TCMT IO) (AbsN Telescope)
forall a b. (a -> b) -> a -> b
$ [ShortText] -> Telescope -> AbsN Telescope
forall a. [ShortText] -> a -> AbsN a
AbsN (Telescope -> [ShortText]
teleNames Telescope
gamma1x) (Telescope -> AbsN Telescope) -> Telescope -> AbsN Telescope
forall a b. (a -> b) -> a -> b
$ Telescope
delta'
    gamma1_size = (Telescope -> Int
forall a. Sized a => a -> Int
size Telescope
gamma1x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
    (gamma1,ExtendTel dType' _) = splitTelescopeAt gamma1_size gamma1x

  old_sides <- forM old_ps' $ \ [NamedArg DeBruijnPattern]
ps -> do
    let vs :: [Int]
vs = [NamedArg DeBruijnPattern] -> [Int]
forall p. IApplyVars p => p -> [Int]
iApplyVars [NamedArg DeBruijnPattern]
ps
    let tm :: Term
tm = QName -> [Elim] -> Term
Def QName
f ([Elim] -> Term) -> [Elim] -> Term
forall a b. (a -> b) -> a -> b
$ [NamedArg DeBruijnPattern] -> [Elim]
patternsToElims [NamedArg DeBruijnPattern]
ps
    xs <- [Int]
-> (Int -> TCMT IO (Term, (Term, Term)))
-> TCMT IO [(Term, (Term, Term))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Int]
vs ((Int -> TCMT IO (Term, (Term, Term)))
 -> TCMT IO [(Term, (Term, Term))])
-> (Int -> TCMT IO (Term, (Term, Term)))
-> TCMT IO [(Term, (Term, Term))]
forall a b. (a -> b) -> a -> b
$ \ Int
v ->
        -- have to reduce these under the appropriate substitutions, otherwise non-normalizing(?)
          ((Term, Term) -> (Term, (Term, Term)))
-> TCMT IO (Term, Term) -> TCMT IO (Term, (Term, Term))
forall a b. (a -> b) -> TCMT IO a -> TCMT IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Term
var Int
v,) (TCMT IO (Term, Term) -> TCMT IO (Term, (Term, Term)))
-> ((Term, Term) -> TCMT IO (Term, Term))
-> (Term, Term)
-> TCMT IO (Term, (Term, Term))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Term, Term) -> TCMT IO (Term, Term)
forall a (m :: * -> *). (Reduce a, MonadReduce m) => a -> m a
reduce ((Term, Term) -> TCMT IO (Term, (Term, Term)))
-> (Term, Term) -> TCMT IO (Term, (Term, Term))
forall a b. (a -> b) -> a -> b
$ (Int -> Term -> Substitution
forall a. EndoSubst a => Int -> a -> Substitution' a
inplaceS Int
v Term
iz Substitution' (SubstArg Term) -> Term -> Term
forall a. Subst a => Substitution' (SubstArg a) -> a -> a
`applySubst` Term
tm, Int -> Term -> Substitution
forall a. EndoSubst a => Int -> a -> Substitution' a
inplaceS Int
v Term
io Substitution' (SubstArg Term) -> Term -> Term
forall a. Subst a => Substitution' (SubstArg a) -> a -> a
`applySubst` Term
tm)
    return $ concatMap (\(Term
v,(Term
l,Term
r)) -> [(Term
tNeg Term -> Args -> Term
forall t. Apply t => t -> Args -> t
`apply` [Term -> Arg Term
forall e. e -> Arg e
argN Term
v],Term
l),(Term
v,Term
r)]) xs
  let
    gamma1ArgNames = Telescope -> [Arg ShortText]
teleArgNames Telescope
gamma1
    deltaArgNames = Telescope -> [Arg ShortText]
teleArgNames Telescope
delta'
  (params,xTel,dT) <- addContext gamma1 $ do
    Just (d, ps, _is) <- getDatatypeArgs . unDom =<< reduce dType'
    def <- getConstInfo d
    let dTy = Definition -> Type
defType Definition
def
    let Datatype{dataSort = s} = theDef def
    TelV tel _ <- telView dTy
    let params = [ShortText] -> Args -> AbsN Args
forall a. [ShortText] -> a -> AbsN a
AbsN (Telescope -> [ShortText]
teleNames Telescope
gamma1) Args
ps
        xTel = [ShortText] -> Telescope -> AbsN Telescope
forall a. [ShortText] -> a -> AbsN a
AbsN (Telescope -> [ShortText]
teleNames Telescope
gamma1) (Telescope
tel Telescope -> Args -> Telescope
forall t. Apply t => t -> Args -> t
`apply` Args
ps)

    dT <- runNamesT [] $ do
          s <- open $ AbsN (teleNames tel) s
          bindNArg (teleArgNames gamma1) $ \ ArgVars (TCMT IO)
g1 -> do
          [Arg ShortText]
-> (ArgVars (TCMT IO) -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) (AbsN Type)
forall (m :: * -> *) a.
Monad m =>
[Arg ShortText] -> (ArgVars m -> NamesT m a) -> NamesT m (AbsN a)
bindNArg (Telescope -> [Arg ShortText]
teleArgNames (Telescope -> [Arg ShortText]) -> Telescope -> [Arg ShortText]
forall a b. (a -> b) -> a -> b
$ AbsN Telescope -> Telescope
forall a. AbsN a -> a
unAbsN AbsN Telescope
xTel) ((ArgVars (TCMT IO) -> NamesT (TCMT IO) Type)
 -> NamesT (TCMT IO) (AbsN Type))
-> (ArgVars (TCMT IO) -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) (AbsN Type)
forall a b. (a -> b) -> a -> b
$ \ ArgVars (TCMT IO)
x -> do
          params <- AbsN Args -> NamesT (TCMT IO) (AbsN Args)
forall a. a -> NamesT (TCMT IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure AbsN Args
params NamesT (TCMT IO) (AbsN Args)
-> [NamesT (TCMT IO) (SubstArg Args)] -> NamesT (TCMT IO) Args
forall (m :: * -> *) a.
(Monad m, Subst a) =>
NamesT m (AbsN a) -> [NamesT m (SubstArg a)] -> NamesT m a
`applyN` ((Arg Term -> Term)
-> NamesT (TCMT IO) (Arg Term) -> NamesT (TCMT IO) Term
forall a b. (a -> b) -> NamesT (TCMT IO) a -> NamesT (TCMT IO) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Arg Term -> Term
forall e. Arg e -> e
unArg (NamesT (TCMT IO) (Arg Term) -> NamesT (TCMT IO) Term)
-> [NamesT (TCMT IO) (Arg Term)] -> [NamesT (TCMT IO) Term]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [NamesT (TCMT IO) (Arg Term)]
ArgVars (TCMT IO)
g1)
          x      <- sequence x
          s <- s `applyN` map (pure . unArg) (params ++ x)
          pure $ El s $ Def d [] `apply` (params ++ x)
    return $ (params, xTel,dT)

  let
    xTelI = AbsN Telescope -> NamesT (TCMT IO) (AbsN Telescope)
forall a. a -> NamesT (TCMT IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AbsN Telescope -> NamesT (TCMT IO) (AbsN Telescope))
-> AbsN Telescope -> NamesT (TCMT IO) (AbsN Telescope)
forall a b. (a -> b) -> a -> b
$ Type -> Telescope -> Telescope
expTelescope Type
interval (Telescope -> Telescope) -> AbsN Telescope -> AbsN Telescope
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AbsN Telescope
xTel
    xTelIArgNames = Telescope -> [Arg ShortText]
teleArgNames (AbsN Telescope -> Telescope
forall a. AbsN a -> a
unAbsN AbsN Telescope
xTel) -- same names

  -- Γ1, φ, p, ψ, q, x0 ⊢ pat := trX p φ (trX q ψ x0)
  let trX' = [Arg ShortText]
-> (ArgVars (TCMT IO)
    -> NamesT (TCMT IO) (AbsN (AbsN DeBruijnPattern)))
-> NamesT (TCMT IO) (AbsN (AbsN (AbsN DeBruijnPattern)))
forall (m :: * -> *) a.
Monad m =>
[Arg ShortText] -> (ArgVars m -> NamesT m a) -> NamesT m (AbsN a)
bindNArg [Arg ShortText]
gamma1ArgNames ((ArgVars (TCMT IO)
  -> NamesT (TCMT IO) (AbsN (AbsN DeBruijnPattern)))
 -> NamesT (TCMT IO) (AbsN (AbsN (AbsN DeBruijnPattern))))
-> (ArgVars (TCMT IO)
    -> NamesT (TCMT IO) (AbsN (AbsN DeBruijnPattern)))
-> NamesT (TCMT IO) (AbsN (AbsN (AbsN DeBruijnPattern)))
forall a b. (a -> b) -> a -> b
$ \ ArgVars (TCMT IO)
g1 -> do
             [Arg ShortText]
-> (ArgVars (TCMT IO) -> NamesT (TCMT IO) (AbsN DeBruijnPattern))
-> NamesT (TCMT IO) (AbsN (AbsN DeBruijnPattern))
forall (m :: * -> *) a.
Monad m =>
[Arg ShortText] -> (ArgVars m -> NamesT m a) -> NamesT m (AbsN a)
bindNArg ([ShortText -> Arg ShortText
forall e. e -> Arg e
defaultArg ShortText
"phi"] [Arg ShortText] -> [Arg ShortText] -> [Arg ShortText]
forall a. [a] -> [a] -> [a]
++ [Arg ShortText]
xTelIArgNames) ((ArgVars (TCMT IO) -> NamesT (TCMT IO) (AbsN DeBruijnPattern))
 -> NamesT (TCMT IO) (AbsN (AbsN DeBruijnPattern)))
-> (ArgVars (TCMT IO) -> NamesT (TCMT IO) (AbsN DeBruijnPattern))
-> NamesT (TCMT IO) (AbsN (AbsN DeBruijnPattern))
forall a b. (a -> b) -> a -> b
$ \ ArgVars (TCMT IO)
phi_p -> do
             [Arg ShortText]
-> (ArgVars (TCMT IO) -> NamesT (TCMT IO) DeBruijnPattern)
-> NamesT (TCMT IO) (AbsN DeBruijnPattern)
forall (m :: * -> *) a.
Monad m =>
[Arg ShortText] -> (ArgVars m -> NamesT m a) -> NamesT m (AbsN a)
bindNArg [ShortText -> Arg ShortText
forall e. e -> Arg e
defaultArg ShortText
"x0"] ((ArgVars (TCMT IO) -> NamesT (TCMT IO) DeBruijnPattern)
 -> NamesT (TCMT IO) (AbsN DeBruijnPattern))
-> (ArgVars (TCMT IO) -> NamesT (TCMT IO) DeBruijnPattern)
-> NamesT (TCMT IO) (AbsN DeBruijnPattern)
forall a b. (a -> b) -> a -> b
$ \ ArgVars (TCMT IO)
x0 -> do
             param_args <- (Args -> [NamedArg DeBruijnPattern])
-> NamesT (TCMT IO) Args
-> NamesT (TCMT IO) [NamedArg DeBruijnPattern]
forall a b. (a -> b) -> NamesT (TCMT IO) a -> NamesT (TCMT IO) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Arg Term -> NamedArg DeBruijnPattern)
-> Args -> [NamedArg DeBruijnPattern]
forall a b. (a -> b) -> [a] -> [b]
map (Hiding -> NamedArg DeBruijnPattern -> NamedArg DeBruijnPattern
forall a. LensHiding a => Hiding -> a -> a
setHiding Hiding
Hidden (NamedArg DeBruijnPattern -> NamedArg DeBruijnPattern)
-> (Arg Term -> NamedArg DeBruijnPattern)
-> Arg Term
-> NamedArg DeBruijnPattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Term -> Named_ DeBruijnPattern)
-> Arg Term -> NamedArg DeBruijnPattern
forall a b. (a -> b) -> Arg a -> Arg b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (DeBruijnPattern -> Named_ DeBruijnPattern
forall a name. a -> Named name a
unnamed (DeBruijnPattern -> Named_ DeBruijnPattern)
-> (Term -> DeBruijnPattern) -> Term -> Named_ DeBruijnPattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term -> DeBruijnPattern
forall a. Term -> Pattern' a
dotP))) (NamesT (TCMT IO) Args
 -> NamesT (TCMT IO) [NamedArg DeBruijnPattern])
-> NamesT (TCMT IO) Args
-> NamesT (TCMT IO) [NamedArg DeBruijnPattern]
forall a b. (a -> b) -> a -> b
$
               AbsN Args -> NamesT (TCMT IO) (AbsN Args)
forall a. a -> NamesT (TCMT IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure AbsN Args
params NamesT (TCMT IO) (AbsN Args)
-> [NamesT (TCMT IO) (SubstArg Args)] -> NamesT (TCMT IO) Args
forall (m :: * -> *) a.
(Monad m, Subst a) =>
NamesT m (AbsN a) -> [NamesT m (SubstArg a)] -> NamesT m a
`applyN` ((Arg Term -> Term)
-> NamesT (TCMT IO) (Arg Term) -> NamesT (TCMT IO) Term
forall a b. (a -> b) -> NamesT (TCMT IO) a -> NamesT (TCMT IO) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Arg Term -> Term
forall e. Arg e -> e
unArg (NamesT (TCMT IO) (Arg Term) -> NamesT (TCMT IO) Term)
-> [NamesT (TCMT IO) (Arg Term)] -> [NamesT (TCMT IO) Term]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [NamesT (TCMT IO) (Arg Term)]
ArgVars (TCMT IO)
g1)
             (phi, p) <- fromMaybe __IMPOSSIBLE__ . uncons <$> sequence phi_p
             x0 <- sequence x0
             pure $ DefP defaultPatternInfo q_trX $ param_args ++ p ++ [phi] ++ x0
      trX = ((AbsN (AbsN DeBruijnPattern) -> AbsN (AbsN Term))
-> AbsN (AbsN (AbsN DeBruijnPattern)) -> AbsN (AbsN (AbsN Term))
forall a b. (a -> b) -> AbsN a -> AbsN b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((AbsN (AbsN DeBruijnPattern) -> AbsN (AbsN Term))
 -> AbsN (AbsN (AbsN DeBruijnPattern)) -> AbsN (AbsN (AbsN Term)))
-> ((DeBruijnPattern -> Term)
    -> AbsN (AbsN DeBruijnPattern) -> AbsN (AbsN Term))
-> (DeBruijnPattern -> Term)
-> AbsN (AbsN (AbsN DeBruijnPattern))
-> AbsN (AbsN (AbsN Term))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AbsN DeBruijnPattern -> AbsN Term)
-> AbsN (AbsN DeBruijnPattern) -> AbsN (AbsN Term)
forall a b. (a -> b) -> AbsN a -> AbsN b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((AbsN DeBruijnPattern -> AbsN Term)
 -> AbsN (AbsN DeBruijnPattern) -> AbsN (AbsN Term))
-> ((DeBruijnPattern -> Term) -> AbsN DeBruijnPattern -> AbsN Term)
-> (DeBruijnPattern -> Term)
-> AbsN (AbsN DeBruijnPattern)
-> AbsN (AbsN Term)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DeBruijnPattern -> Term) -> AbsN DeBruijnPattern -> AbsN Term
forall a b. (a -> b) -> AbsN a -> AbsN b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) DeBruijnPattern -> Term
patternToTerm (AbsN (AbsN (AbsN DeBruijnPattern)) -> AbsN (AbsN (AbsN Term)))
-> NamesT (TCMT IO) (AbsN (AbsN (AbsN DeBruijnPattern)))
-> NamesT (TCMT IO) (AbsN (AbsN (AbsN Term)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamesT (TCMT IO) (AbsN (AbsN (AbsN DeBruijnPattern)))
trX'
  let pat' =
            [ShortText]
-> (Vars (TCMT IO)
    -> NamesT (TCMT IO) (AbsN (AbsN (AbsN DeBruijnPattern))))
-> NamesT (TCMT IO) (AbsN (AbsN (AbsN (AbsN DeBruijnPattern))))
forall (m :: * -> *) a.
Monad m =>
[ShortText] -> (Vars m -> NamesT m a) -> NamesT m (AbsN a)
bindN ((Arg ShortText -> ShortText) -> [Arg ShortText] -> [ShortText]
forall a b. (a -> b) -> [a] -> [b]
map Arg ShortText -> ShortText
forall e. Arg e -> e
unArg [Arg ShortText]
gamma1ArgNames) ((Vars (TCMT IO)
  -> NamesT (TCMT IO) (AbsN (AbsN (AbsN DeBruijnPattern))))
 -> NamesT (TCMT IO) (AbsN (AbsN (AbsN (AbsN DeBruijnPattern)))))
-> (Vars (TCMT IO)
    -> NamesT (TCMT IO) (AbsN (AbsN (AbsN DeBruijnPattern))))
-> NamesT (TCMT IO) (AbsN (AbsN (AbsN (AbsN DeBruijnPattern))))
forall a b. (a -> b) -> a -> b
$ \ Vars (TCMT IO)
g1 -> do
            [ShortText]
-> (Vars (TCMT IO)
    -> NamesT (TCMT IO) (AbsN (AbsN DeBruijnPattern)))
-> NamesT (TCMT IO) (AbsN (AbsN (AbsN DeBruijnPattern)))
forall (m :: * -> *) a.
Monad m =>
[ShortText] -> (Vars m -> NamesT m a) -> NamesT m (AbsN a)
bindN ((Arg ShortText -> ShortText) -> [Arg ShortText] -> [ShortText]
forall a b. (a -> b) -> [a] -> [b]
map Arg ShortText -> ShortText
forall e. Arg e -> e
unArg ([Arg ShortText] -> [ShortText]) -> [Arg ShortText] -> [ShortText]
forall a b. (a -> b) -> a -> b
$ ([ShortText -> Arg ShortText
forall e. e -> Arg e
defaultArg ShortText
"phi"] [Arg ShortText] -> [Arg ShortText] -> [Arg ShortText]
forall a. [a] -> [a] -> [a]
++ [Arg ShortText]
xTelIArgNames)) ((Vars (TCMT IO) -> NamesT (TCMT IO) (AbsN (AbsN DeBruijnPattern)))
 -> NamesT (TCMT IO) (AbsN (AbsN (AbsN DeBruijnPattern))))
-> (Vars (TCMT IO)
    -> NamesT (TCMT IO) (AbsN (AbsN DeBruijnPattern)))
-> NamesT (TCMT IO) (AbsN (AbsN (AbsN DeBruijnPattern)))
forall a b. (a -> b) -> a -> b
$ \ Vars (TCMT IO)
phi_p -> do
            [ShortText]
-> (Vars (TCMT IO) -> NamesT (TCMT IO) (AbsN DeBruijnPattern))
-> NamesT (TCMT IO) (AbsN (AbsN DeBruijnPattern))
forall (m :: * -> *) a.
Monad m =>
[ShortText] -> (Vars m -> NamesT m a) -> NamesT m (AbsN a)
bindN ((Arg ShortText -> ShortText) -> [Arg ShortText] -> [ShortText]
forall a b. (a -> b) -> [a] -> [b]
map Arg ShortText -> ShortText
forall e. Arg e -> e
unArg ([Arg ShortText] -> [ShortText]) -> [Arg ShortText] -> [ShortText]
forall a b. (a -> b) -> a -> b
$ ([ShortText -> Arg ShortText
forall e. e -> Arg e
defaultArg ShortText
"psi"] [Arg ShortText] -> [Arg ShortText] -> [Arg ShortText]
forall a. [a] -> [a] -> [a]
++ [Arg ShortText]
xTelIArgNames)) ((Vars (TCMT IO) -> NamesT (TCMT IO) (AbsN DeBruijnPattern))
 -> NamesT (TCMT IO) (AbsN (AbsN DeBruijnPattern)))
-> (Vars (TCMT IO) -> NamesT (TCMT IO) (AbsN DeBruijnPattern))
-> NamesT (TCMT IO) (AbsN (AbsN DeBruijnPattern))
forall a b. (a -> b) -> a -> b
$ \ Vars (TCMT IO)
psi_q -> do
            [ShortText]
-> (Vars (TCMT IO) -> NamesT (TCMT IO) DeBruijnPattern)
-> NamesT (TCMT IO) (AbsN DeBruijnPattern)
forall (m :: * -> *) a.
Monad m =>
[ShortText] -> (Vars m -> NamesT m a) -> NamesT m (AbsN a)
bindN ((Arg ShortText -> ShortText) -> [Arg ShortText] -> [ShortText]
forall a b. (a -> b) -> [a] -> [b]
map Arg ShortText -> ShortText
forall e. Arg e -> e
unArg ([Arg ShortText] -> [ShortText]) -> [Arg ShortText] -> [ShortText]
forall a b. (a -> b) -> a -> b
$ [ShortText -> Arg ShortText
forall e. e -> Arg e
defaultArg ShortText
"x0"]) ((Vars (TCMT IO) -> NamesT (TCMT IO) DeBruijnPattern)
 -> NamesT (TCMT IO) (AbsN DeBruijnPattern))
-> (Vars (TCMT IO) -> NamesT (TCMT IO) DeBruijnPattern)
-> NamesT (TCMT IO) (AbsN DeBruijnPattern)
forall a b. (a -> b) -> a -> b
$ \ Vars (TCMT IO)
x0 -> do
            -- (phi:p) <- sequence phi_p
            -- (psi:q) <- sequence psi_q
            -- x0 <- sequence x0
            let trX :: NamesT (TCMT IO) (AbsN (AbsN DeBruijnPattern))
trX = NamesT (TCMT IO) (AbsN (AbsN (AbsN DeBruijnPattern)))
trX' NamesT (TCMT IO) (AbsN (AbsN (AbsN DeBruijnPattern)))
-> [NamesT (TCMT IO) (SubstArg (AbsN (AbsN DeBruijnPattern)))]
-> NamesT (TCMT IO) (AbsN (AbsN DeBruijnPattern))
forall (m :: * -> *) a.
(Monad m, Subst a) =>
NamesT m (AbsN a) -> [NamesT m (SubstArg a)] -> NamesT m a
`applyN` [NamesT (TCMT IO) DeBruijnPattern]
[NamesT (TCMT IO) (SubstArg (AbsN (AbsN DeBruijnPattern)))]
Vars (TCMT IO)
g1
            NamesT (TCMT IO) (AbsN (AbsN DeBruijnPattern))
trX NamesT (TCMT IO) (AbsN (AbsN DeBruijnPattern))
-> [NamesT (TCMT IO) (SubstArg (AbsN DeBruijnPattern))]
-> NamesT (TCMT IO) (AbsN DeBruijnPattern)
forall (m :: * -> *) a.
(Monad m, Subst a) =>
NamesT m (AbsN a) -> [NamesT m (SubstArg a)] -> NamesT m a
`applyN` [NamesT (TCMT IO) DeBruijnPattern]
[NamesT (TCMT IO) (SubstArg (AbsN DeBruijnPattern))]
Vars (TCMT IO)
phi_p NamesT (TCMT IO) (AbsN DeBruijnPattern)
-> [NamesT (TCMT IO) (SubstArg DeBruijnPattern)]
-> NamesT (TCMT IO) DeBruijnPattern
forall (m :: * -> *) a.
(Monad m, Subst a) =>
NamesT m (AbsN a) -> [NamesT m (SubstArg a)] -> NamesT m a
`applyN` [NamesT (TCMT IO) (AbsN (AbsN DeBruijnPattern))
trX NamesT (TCMT IO) (AbsN (AbsN DeBruijnPattern))
-> [NamesT (TCMT IO) (SubstArg (AbsN DeBruijnPattern))]
-> NamesT (TCMT IO) (AbsN DeBruijnPattern)
forall (m :: * -> *) a.
(Monad m, Subst a) =>
NamesT m (AbsN a) -> [NamesT m (SubstArg a)] -> NamesT m a
`applyN` [NamesT (TCMT IO) DeBruijnPattern]
[NamesT (TCMT IO) (SubstArg (AbsN DeBruijnPattern))]
Vars (TCMT IO)
psi_q NamesT (TCMT IO) (AbsN DeBruijnPattern)
-> [NamesT (TCMT IO) (SubstArg DeBruijnPattern)]
-> NamesT (TCMT IO) DeBruijnPattern
forall (m :: * -> *) a.
(Monad m, Subst a) =>
NamesT m (AbsN a) -> [NamesT m (SubstArg a)] -> NamesT m a
`applyN` [NamesT (TCMT IO) DeBruijnPattern]
[NamesT (TCMT IO) (SubstArg DeBruijnPattern)]
Vars (TCMT IO)
x0]
          --  pure $ trX $ p ++ [phi, defaultArg $ unnamed $ trX $ q ++ [psi] ++ x0]
      pat = ((AbsN (AbsN (AbsN DeBruijnPattern)) -> AbsN (AbsN (AbsN Term)))
-> AbsN (AbsN (AbsN (AbsN DeBruijnPattern)))
-> AbsN (AbsN (AbsN (AbsN Term)))
forall a b. (a -> b) -> AbsN a -> AbsN b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((AbsN (AbsN (AbsN DeBruijnPattern)) -> AbsN (AbsN (AbsN Term)))
 -> AbsN (AbsN (AbsN (AbsN DeBruijnPattern)))
 -> AbsN (AbsN (AbsN (AbsN Term))))
-> ((DeBruijnPattern -> Term)
    -> AbsN (AbsN (AbsN DeBruijnPattern)) -> AbsN (AbsN (AbsN Term)))
-> (DeBruijnPattern -> Term)
-> AbsN (AbsN (AbsN (AbsN DeBruijnPattern)))
-> AbsN (AbsN (AbsN (AbsN Term)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AbsN (AbsN DeBruijnPattern) -> AbsN (AbsN Term))
-> AbsN (AbsN (AbsN DeBruijnPattern)) -> AbsN (AbsN (AbsN Term))
forall a b. (a -> b) -> AbsN a -> AbsN b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((AbsN (AbsN DeBruijnPattern) -> AbsN (AbsN Term))
 -> AbsN (AbsN (AbsN DeBruijnPattern)) -> AbsN (AbsN (AbsN Term)))
-> ((DeBruijnPattern -> Term)
    -> AbsN (AbsN DeBruijnPattern) -> AbsN (AbsN Term))
-> (DeBruijnPattern -> Term)
-> AbsN (AbsN (AbsN DeBruijnPattern))
-> AbsN (AbsN (AbsN Term))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AbsN DeBruijnPattern -> AbsN Term)
-> AbsN (AbsN DeBruijnPattern) -> AbsN (AbsN Term)
forall a b. (a -> b) -> AbsN a -> AbsN b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((AbsN DeBruijnPattern -> AbsN Term)
 -> AbsN (AbsN DeBruijnPattern) -> AbsN (AbsN Term))
-> ((DeBruijnPattern -> Term) -> AbsN DeBruijnPattern -> AbsN Term)
-> (DeBruijnPattern -> Term)
-> AbsN (AbsN DeBruijnPattern)
-> AbsN (AbsN Term)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DeBruijnPattern -> Term) -> AbsN DeBruijnPattern -> AbsN Term
forall a b. (a -> b) -> AbsN a -> AbsN b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) DeBruijnPattern -> Term
patternToTerm (AbsN (AbsN (AbsN (AbsN DeBruijnPattern)))
 -> AbsN (AbsN (AbsN (AbsN Term))))
-> NamesT (TCMT IO) (AbsN (AbsN (AbsN (AbsN DeBruijnPattern))))
-> NamesT (TCMT IO) (AbsN (AbsN (AbsN (AbsN Term))))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamesT (TCMT IO) (AbsN (AbsN (AbsN (AbsN DeBruijnPattern))))
pat'
  let deltaPat [NamesT (TCMT IO) Term]
g1 NamesT (TCMT IO) Term
phi [NamesT (TCMT IO) Term]
p NamesT (TCMT IO) Term
psi [NamesT (TCMT IO) Term]
q NamesT (TCMT IO) Term
x0 =
        NamesT (TCMT IO) (AbsN Telescope)
delta NamesT (TCMT IO) (AbsN Telescope)
-> [NamesT (TCMT IO) (SubstArg Telescope)]
-> NamesT (TCMT IO) Telescope
forall (m :: * -> *) a.
(Monad m, Subst a) =>
NamesT m (AbsN a) -> [NamesT m (SubstArg a)] -> NamesT m a
`applyN` ([NamesT (TCMT IO) Term]
g1 [NamesT (TCMT IO) Term]
-> [NamesT (TCMT IO) Term] -> [NamesT (TCMT IO) Term]
forall a. [a] -> [a] -> [a]
++ [NamesT (TCMT IO) (AbsN (AbsN (AbsN (AbsN Term))))
pat NamesT (TCMT IO) (AbsN (AbsN (AbsN (AbsN Term))))
-> [NamesT (TCMT IO) (SubstArg (AbsN (AbsN (AbsN Term))))]
-> NamesT (TCMT IO) (AbsN (AbsN (AbsN Term)))
forall (m :: * -> *) a.
(Monad m, Subst a) =>
NamesT m (AbsN a) -> [NamesT m (SubstArg a)] -> NamesT m a
`applyN` [NamesT (TCMT IO) Term]
[NamesT (TCMT IO) (SubstArg (AbsN (AbsN (AbsN Term))))]
g1 NamesT (TCMT IO) (AbsN (AbsN (AbsN Term)))
-> [NamesT (TCMT IO) (SubstArg (AbsN (AbsN Term)))]
-> NamesT (TCMT IO) (AbsN (AbsN Term))
forall (m :: * -> *) a.
(Monad m, Subst a) =>
NamesT m (AbsN a) -> [NamesT m (SubstArg a)] -> NamesT m a
`applyN` (NamesT (TCMT IO) Term
phiNamesT (TCMT IO) Term
-> [NamesT (TCMT IO) Term] -> [NamesT (TCMT IO) Term]
forall a. a -> [a] -> [a]
:[NamesT (TCMT IO) Term]
p) NamesT (TCMT IO) (AbsN (AbsN Term))
-> [NamesT (TCMT IO) (SubstArg (AbsN Term))]
-> NamesT (TCMT IO) (AbsN Term)
forall (m :: * -> *) a.
(Monad m, Subst a) =>
NamesT m (AbsN a) -> [NamesT m (SubstArg a)] -> NamesT m a
`applyN` (NamesT (TCMT IO) Term
psiNamesT (TCMT IO) Term
-> [NamesT (TCMT IO) Term] -> [NamesT (TCMT IO) Term]
forall a. a -> [a] -> [a]
:[NamesT (TCMT IO) Term]
q) NamesT (TCMT IO) (AbsN Term)
-> [NamesT (TCMT IO) (SubstArg Term)] -> NamesT (TCMT IO) Term
forall (m :: * -> *) a.
(Monad m, Subst a) =>
NamesT m (AbsN a) -> [NamesT m (SubstArg a)] -> NamesT m a
`applyN` [NamesT (TCMT IO) Term
NamesT (TCMT IO) (SubstArg Term)
x0]])
  -- Ξ
  cTel <- runNamesT [] $
    abstractN (pure gamma1) $ \ Vars (TCMT IO)
g1 -> do
    ShortText
-> NamesT (TCMT IO) Type
-> (Var (TCMT IO) -> NamesT (TCMT IO) Telescope)
-> NamesT (TCMT IO) Telescope
forall (m :: * -> *) a.
(Monad m, Abstract a) =>
ShortText -> NamesT m Type -> (Var m -> NamesT m a) -> NamesT m a
abstractT ShortText
"φ" (Type -> NamesT (TCMT IO) Type
forall a. a -> NamesT (TCMT IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Type
interval) ((Var (TCMT IO) -> NamesT (TCMT IO) Telescope)
 -> NamesT (TCMT IO) Telescope)
-> (Var (TCMT IO) -> NamesT (TCMT IO) Telescope)
-> NamesT (TCMT IO) Telescope
forall a b. (a -> b) -> a -> b
$ \ Var (TCMT IO)
phi -> do
    NamesT (TCMT IO) Telescope
-> (Vars (TCMT IO) -> NamesT (TCMT IO) Telescope)
-> NamesT (TCMT IO) Telescope
forall (m :: * -> *) a.
(Monad m, Abstract a) =>
NamesT m Telescope -> (Vars m -> NamesT m a) -> NamesT m a
abstractN (NamesT (TCMT IO) (AbsN Telescope)
xTelI NamesT (TCMT IO) (AbsN Telescope)
-> [NamesT (TCMT IO) (SubstArg Telescope)]
-> NamesT (TCMT IO) Telescope
forall (m :: * -> *) a.
(Monad m, Subst a) =>
NamesT m (AbsN a) -> [NamesT m (SubstArg a)] -> NamesT m a
`applyN` [NamesT (TCMT IO) Term]
[NamesT (TCMT IO) (SubstArg Telescope)]
Vars (TCMT IO)
g1) ((Vars (TCMT IO) -> NamesT (TCMT IO) Telescope)
 -> NamesT (TCMT IO) Telescope)
-> (Vars (TCMT IO) -> NamesT (TCMT IO) Telescope)
-> NamesT (TCMT IO) Telescope
forall a b. (a -> b) -> a -> b
$ \ Vars (TCMT IO)
p -> do
    ShortText
-> NamesT (TCMT IO) Type
-> (Var (TCMT IO) -> NamesT (TCMT IO) Telescope)
-> NamesT (TCMT IO) Telescope
forall (m :: * -> *) a.
(Monad m, Abstract a) =>
ShortText -> NamesT m Type -> (Var m -> NamesT m a) -> NamesT m a
abstractT ShortText
"ψ" (Type -> NamesT (TCMT IO) Type
forall a. a -> NamesT (TCMT IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Type
interval) ((Var (TCMT IO) -> NamesT (TCMT IO) Telescope)
 -> NamesT (TCMT IO) Telescope)
-> (Var (TCMT IO) -> NamesT (TCMT IO) Telescope)
-> NamesT (TCMT IO) Telescope
forall a b. (a -> b) -> a -> b
$ \ Var (TCMT IO)
psi -> do
    NamesT (TCMT IO) Telescope
-> (Vars (TCMT IO) -> NamesT (TCMT IO) Telescope)
-> NamesT (TCMT IO) Telescope
forall (m :: * -> *) a.
(Monad m, Abstract a) =>
NamesT m Telescope -> (Vars m -> NamesT m a) -> NamesT m a
abstractN (NamesT (TCMT IO) (AbsN Telescope)
xTelI NamesT (TCMT IO) (AbsN Telescope)
-> [NamesT (TCMT IO) (SubstArg Telescope)]
-> NamesT (TCMT IO) Telescope
forall (m :: * -> *) a.
(Monad m, Subst a) =>
NamesT m (AbsN a) -> [NamesT m (SubstArg a)] -> NamesT m a
`applyN` [NamesT (TCMT IO) Term]
[NamesT (TCMT IO) (SubstArg Telescope)]
Vars (TCMT IO)
g1) ((Vars (TCMT IO) -> NamesT (TCMT IO) Telescope)
 -> NamesT (TCMT IO) Telescope)
-> (Vars (TCMT IO) -> NamesT (TCMT IO) Telescope)
-> NamesT (TCMT IO) Telescope
forall a b. (a -> b) -> a -> b
$ \ Vars (TCMT IO)
q -> do
    ShortText
-> NamesT (TCMT IO) Type
-> (Var (TCMT IO) -> NamesT (TCMT IO) Telescope)
-> NamesT (TCMT IO) Telescope
forall (m :: * -> *) a.
(Monad m, Abstract a) =>
ShortText -> NamesT m Type -> (Var m -> NamesT m a) -> NamesT m a
abstractT ShortText
"x0" (AbsN (AbsN Type) -> NamesT (TCMT IO) (AbsN (AbsN Type))
forall a. a -> NamesT (TCMT IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure AbsN (AbsN Type)
dT NamesT (TCMT IO) (AbsN (AbsN Type))
-> [NamesT (TCMT IO) (SubstArg (AbsN Type))]
-> NamesT (TCMT IO) (AbsN Type)
forall (m :: * -> *) a.
(Monad m, Subst a) =>
NamesT m (AbsN a) -> [NamesT m (SubstArg a)] -> NamesT m a
`applyN` [NamesT (TCMT IO) Term]
[NamesT (TCMT IO) (SubstArg (AbsN Type))]
Vars (TCMT IO)
g1 NamesT (TCMT IO) (AbsN Type)
-> [NamesT (TCMT IO) (SubstArg Type)] -> NamesT (TCMT IO) Type
forall (m :: * -> *) a.
(Monad m, Subst a) =>
NamesT m (AbsN a) -> [NamesT m (SubstArg a)] -> NamesT m a
`applyN` ([NamesT (TCMT IO) Term]
Vars (TCMT IO)
q [NamesT (TCMT IO) Term]
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> [NamesT (TCMT IO) Term]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \ NamesT (TCMT IO) Term
f -> NamesT (TCMT IO) Term
f NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> Term -> NamesT (TCMT IO) Term
forall a. a -> NamesT (TCMT IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
iz)) ((Var (TCMT IO) -> NamesT (TCMT IO) Telescope)
 -> NamesT (TCMT IO) Telescope)
-> (Var (TCMT IO) -> NamesT (TCMT IO) Telescope)
-> NamesT (TCMT IO) Telescope
forall a b. (a -> b) -> a -> b
$ \ Var (TCMT IO)
x0 -> do
    [NamesT (TCMT IO) Term]
-> NamesT (TCMT IO) Term
-> [NamesT (TCMT IO) Term]
-> NamesT (TCMT IO) Term
-> [NamesT (TCMT IO) Term]
-> NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Telescope
deltaPat [NamesT (TCMT IO) Term]
Vars (TCMT IO)
g1 NamesT (TCMT IO) Term
Var (TCMT IO)
phi [NamesT (TCMT IO) Term]
Vars (TCMT IO)
p NamesT (TCMT IO) Term
Var (TCMT IO)
psi [NamesT (TCMT IO) Term]
Vars (TCMT IO)
q NamesT (TCMT IO) Term
Var (TCMT IO)
x0

  ps_ty_rhs <- runNamesT [] $ do
    bindN (map unArg gamma1ArgNames) $ \ Vars (TCMT IO)
g1 -> do
    ShortText
-> (Var (TCMT IO)
    -> NamesT
         (TCMT IO)
         (AbsN
            (Abs
               (AbsN (Abs (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term)))))))
-> NamesT
     (TCMT IO)
     (Abs
        (AbsN
           (Abs
              (AbsN (Abs (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term)))))))
forall (m :: * -> *) a.
Monad m =>
ShortText
-> ((forall b. (Subst b, DeBruijn b) => NamesT m b) -> NamesT m a)
-> NamesT m (Abs a)
bind ShortText
"φ" ((Var (TCMT IO)
  -> NamesT
       (TCMT IO)
       (AbsN
          (Abs
             (AbsN (Abs (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term)))))))
 -> NamesT
      (TCMT IO)
      (Abs
         (AbsN
            (Abs
               (AbsN
                  (Abs (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term))))))))
-> (Var (TCMT IO)
    -> NamesT
         (TCMT IO)
         (AbsN
            (Abs
               (AbsN (Abs (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term)))))))
-> NamesT
     (TCMT IO)
     (Abs
        (AbsN
           (Abs
              (AbsN (Abs (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term)))))))
forall a b. (a -> b) -> a -> b
$ \ Var (TCMT IO)
phi -> do
    [ShortText]
-> (Vars (TCMT IO)
    -> NamesT
         (TCMT IO)
         (Abs
            (AbsN (Abs (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term))))))
-> NamesT
     (TCMT IO)
     (AbsN
        (Abs
           (AbsN (Abs (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term))))))
forall (m :: * -> *) a.
Monad m =>
[ShortText] -> (Vars m -> NamesT m a) -> NamesT m (AbsN a)
bindN ((Arg ShortText -> ShortText) -> [Arg ShortText] -> [ShortText]
forall a b. (a -> b) -> [a] -> [b]
map Arg ShortText -> ShortText
forall e. Arg e -> e
unArg [Arg ShortText]
xTelIArgNames) ((Vars (TCMT IO)
  -> NamesT
       (TCMT IO)
       (Abs
          (AbsN (Abs (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term))))))
 -> NamesT
      (TCMT IO)
      (AbsN
         (Abs
            (AbsN (Abs (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term)))))))
-> (Vars (TCMT IO)
    -> NamesT
         (TCMT IO)
         (Abs
            (AbsN (Abs (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term))))))
-> NamesT
     (TCMT IO)
     (AbsN
        (Abs
           (AbsN (Abs (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term))))))
forall a b. (a -> b) -> a -> b
$ \ Vars (TCMT IO)
p -> do
    ShortText
-> (Var (TCMT IO)
    -> NamesT
         (TCMT IO)
         (AbsN (Abs (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term)))))
-> NamesT
     (TCMT IO)
     (Abs
        (AbsN (Abs (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term)))))
forall (m :: * -> *) a.
Monad m =>
ShortText
-> ((forall b. (Subst b, DeBruijn b) => NamesT m b) -> NamesT m a)
-> NamesT m (Abs a)
bind ShortText
"ψ" ((Var (TCMT IO)
  -> NamesT
       (TCMT IO)
       (AbsN (Abs (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term)))))
 -> NamesT
      (TCMT IO)
      (Abs
         (AbsN (Abs (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term))))))
-> (Var (TCMT IO)
    -> NamesT
         (TCMT IO)
         (AbsN (Abs (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term)))))
-> NamesT
     (TCMT IO)
     (Abs
        (AbsN (Abs (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term)))))
forall a b. (a -> b) -> a -> b
$ \ Var (TCMT IO)
psi -> do
    [ShortText]
-> (Vars (TCMT IO)
    -> NamesT
         (TCMT IO)
         (Abs (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term))))
-> NamesT
     (TCMT IO)
     (AbsN (Abs (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term))))
forall (m :: * -> *) a.
Monad m =>
[ShortText] -> (Vars m -> NamesT m a) -> NamesT m (AbsN a)
bindN ((Arg ShortText -> ShortText) -> [Arg ShortText] -> [ShortText]
forall a b. (a -> b) -> [a] -> [b]
map Arg ShortText -> ShortText
forall e. Arg e -> e
unArg [Arg ShortText]
xTelIArgNames) ((Vars (TCMT IO)
  -> NamesT
       (TCMT IO)
       (Abs (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term))))
 -> NamesT
      (TCMT IO)
      (AbsN (Abs (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term)))))
-> (Vars (TCMT IO)
    -> NamesT
         (TCMT IO)
         (Abs (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term))))
-> NamesT
     (TCMT IO)
     (AbsN (Abs (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term))))
forall a b. (a -> b) -> a -> b
$ \ Vars (TCMT IO)
q -> do
    ShortText
-> (Var (TCMT IO)
    -> NamesT
         (TCMT IO) (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term)))
-> NamesT
     (TCMT IO) (Abs (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term)))
forall (m :: * -> *) a.
Monad m =>
ShortText
-> ((forall b. (Subst b, DeBruijn b) => NamesT m b) -> NamesT m a)
-> NamesT m (Abs a)
bind ShortText
"x0" ((Var (TCMT IO)
  -> NamesT
       (TCMT IO) (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term)))
 -> NamesT
      (TCMT IO)
      (Abs (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term))))
-> (Var (TCMT IO)
    -> NamesT
         (TCMT IO) (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term)))
-> NamesT
     (TCMT IO) (Abs (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term)))
forall a b. (a -> b) -> a -> b
$ \ Var (TCMT IO)
x0 -> do
    [ShortText]
-> (Vars (TCMT IO)
    -> NamesT (TCMT IO) ([NamedArg DeBruijnPattern], Dom Type, Term))
-> NamesT
     (TCMT IO) (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term))
forall (m :: * -> *) a.
Monad m =>
[ShortText] -> (Vars m -> NamesT m a) -> NamesT m (AbsN a)
bindN ((Arg ShortText -> ShortText) -> [Arg ShortText] -> [ShortText]
forall a b. (a -> b) -> [a] -> [b]
map Arg ShortText -> ShortText
forall e. Arg e -> e
unArg [Arg ShortText]
deltaArgNames) ((Vars (TCMT IO)
  -> NamesT (TCMT IO) ([NamedArg DeBruijnPattern], Dom Type, Term))
 -> NamesT
      (TCMT IO) (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term)))
-> (Vars (TCMT IO)
    -> NamesT (TCMT IO) ([NamedArg DeBruijnPattern], Dom Type, Term))
-> NamesT
     (TCMT IO) (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term))
forall a b. (a -> b) -> a -> b
$ \ Vars (TCMT IO)
d -> do
    let
      ps :: NamesT TCM NAPs
      ps :: NamesT (TCMT IO) [NamedArg DeBruijnPattern]
ps = NamesT (TCMT IO) (AbsN [NamedArg DeBruijnPattern])
old_ps NamesT (TCMT IO) (AbsN [NamedArg DeBruijnPattern])
-> [NamesT (TCMT IO) (SubstArg [NamedArg DeBruijnPattern])]
-> NamesT (TCMT IO) [NamedArg DeBruijnPattern]
forall (m :: * -> *) a.
(Monad m, Subst a) =>
NamesT m (AbsN a) -> [NamesT m (SubstArg a)] -> NamesT m a
`applyN` ([NamesT (TCMT IO) DeBruijnPattern]
Vars (TCMT IO)
g1
                          [NamesT (TCMT IO) DeBruijnPattern]
-> [NamesT (TCMT IO) DeBruijnPattern]
-> [NamesT (TCMT IO) DeBruijnPattern]
forall a. [a] -> [a] -> [a]
++ [NamesT (TCMT IO) (AbsN (AbsN (AbsN (AbsN DeBruijnPattern))))
pat' NamesT (TCMT IO) (AbsN (AbsN (AbsN (AbsN DeBruijnPattern))))
-> [NamesT
      (TCMT IO) (SubstArg (AbsN (AbsN (AbsN DeBruijnPattern))))]
-> NamesT (TCMT IO) (AbsN (AbsN (AbsN DeBruijnPattern)))
forall (m :: * -> *) a.
(Monad m, Subst a) =>
NamesT m (AbsN a) -> [NamesT m (SubstArg a)] -> NamesT m a
`applyN` [NamesT (TCMT IO) DeBruijnPattern]
[NamesT (TCMT IO) (SubstArg (AbsN (AbsN (AbsN DeBruijnPattern))))]
Vars (TCMT IO)
g1 NamesT (TCMT IO) (AbsN (AbsN (AbsN DeBruijnPattern)))
-> [NamesT (TCMT IO) (SubstArg (AbsN (AbsN DeBruijnPattern)))]
-> NamesT (TCMT IO) (AbsN (AbsN DeBruijnPattern))
forall (m :: * -> *) a.
(Monad m, Subst a) =>
NamesT m (AbsN a) -> [NamesT m (SubstArg a)] -> NamesT m a
`applyN` (NamesT (TCMT IO) DeBruijnPattern
Var (TCMT IO)
phiNamesT (TCMT IO) DeBruijnPattern
-> [NamesT (TCMT IO) DeBruijnPattern]
-> [NamesT (TCMT IO) DeBruijnPattern]
forall a. a -> [a] -> [a]
:[NamesT (TCMT IO) DeBruijnPattern]
Vars (TCMT IO)
p) NamesT (TCMT IO) (AbsN (AbsN DeBruijnPattern))
-> [NamesT (TCMT IO) (SubstArg (AbsN DeBruijnPattern))]
-> NamesT (TCMT IO) (AbsN DeBruijnPattern)
forall (m :: * -> *) a.
(Monad m, Subst a) =>
NamesT m (AbsN a) -> [NamesT m (SubstArg a)] -> NamesT m a
`applyN` (NamesT (TCMT IO) DeBruijnPattern
Var (TCMT IO)
psiNamesT (TCMT IO) DeBruijnPattern
-> [NamesT (TCMT IO) DeBruijnPattern]
-> [NamesT (TCMT IO) DeBruijnPattern]
forall a. a -> [a] -> [a]
:[NamesT (TCMT IO) DeBruijnPattern]
Vars (TCMT IO)
q) NamesT (TCMT IO) (AbsN DeBruijnPattern)
-> [NamesT (TCMT IO) (SubstArg DeBruijnPattern)]
-> NamesT (TCMT IO) DeBruijnPattern
forall (m :: * -> *) a.
(Monad m, Subst a) =>
NamesT m (AbsN a) -> [NamesT m (SubstArg a)] -> NamesT m a
`applyN` [NamesT (TCMT IO) DeBruijnPattern
NamesT (TCMT IO) (SubstArg DeBruijnPattern)
Var (TCMT IO)
x0]]
                          [NamesT (TCMT IO) DeBruijnPattern]
-> [NamesT (TCMT IO) DeBruijnPattern]
-> [NamesT (TCMT IO) DeBruijnPattern]
forall a. [a] -> [a] -> [a]
++ [NamesT (TCMT IO) DeBruijnPattern]
Vars (TCMT IO)
d)

      rhsTy :: NamesT (TCMT IO) (Dom Type)
rhsTy = NamesT (TCMT IO) (AbsN (Dom Type))
old_ty NamesT (TCMT IO) (AbsN (Dom Type))
-> [NamesT (TCMT IO) (SubstArg (Dom Type))]
-> NamesT (TCMT IO) (Dom Type)
forall (m :: * -> *) a.
(Monad m, Subst a) =>
NamesT m (AbsN a) -> [NamesT m (SubstArg a)] -> NamesT m a
`applyN` ([NamesT (TCMT IO) Term]
Vars (TCMT IO)
g1
                          [NamesT (TCMT IO) Term]
-> [NamesT (TCMT IO) Term] -> [NamesT (TCMT IO) Term]
forall a. [a] -> [a] -> [a]
++ [NamesT (TCMT IO) (AbsN (AbsN (AbsN (AbsN Term))))
pat NamesT (TCMT IO) (AbsN (AbsN (AbsN (AbsN Term))))
-> [NamesT (TCMT IO) (SubstArg (AbsN (AbsN (AbsN Term))))]
-> NamesT (TCMT IO) (AbsN (AbsN (AbsN Term)))
forall (m :: * -> *) a.
(Monad m, Subst a) =>
NamesT m (AbsN a) -> [NamesT m (SubstArg a)] -> NamesT m a
`applyN` [NamesT (TCMT IO) Term]
[NamesT (TCMT IO) (SubstArg (AbsN (AbsN (AbsN Term))))]
Vars (TCMT IO)
g1 NamesT (TCMT IO) (AbsN (AbsN (AbsN Term)))
-> [NamesT (TCMT IO) (SubstArg (AbsN (AbsN Term)))]
-> NamesT (TCMT IO) (AbsN (AbsN Term))
forall (m :: * -> *) a.
(Monad m, Subst a) =>
NamesT m (AbsN a) -> [NamesT m (SubstArg a)] -> NamesT m a
`applyN` (NamesT (TCMT IO) Term
Var (TCMT IO)
phiNamesT (TCMT IO) Term
-> [NamesT (TCMT IO) Term] -> [NamesT (TCMT IO) Term]
forall a. a -> [a] -> [a]
:[NamesT (TCMT IO) Term]
Vars (TCMT IO)
p) NamesT (TCMT IO) (AbsN (AbsN Term))
-> [NamesT (TCMT IO) (SubstArg (AbsN Term))]
-> NamesT (TCMT IO) (AbsN Term)
forall (m :: * -> *) a.
(Monad m, Subst a) =>
NamesT m (AbsN a) -> [NamesT m (SubstArg a)] -> NamesT m a
`applyN` (NamesT (TCMT IO) Term
Var (TCMT IO)
psiNamesT (TCMT IO) Term
-> [NamesT (TCMT IO) Term] -> [NamesT (TCMT IO) Term]
forall a. a -> [a] -> [a]
:[NamesT (TCMT IO) Term]
Vars (TCMT IO)
q) NamesT (TCMT IO) (AbsN Term)
-> [NamesT (TCMT IO) (SubstArg Term)] -> NamesT (TCMT IO) Term
forall (m :: * -> *) a.
(Monad m, Subst a) =>
NamesT m (AbsN a) -> [NamesT m (SubstArg a)] -> NamesT m a
`applyN` [NamesT (TCMT IO) Term
NamesT (TCMT IO) (SubstArg Term)
Var (TCMT IO)
x0]]
                          [NamesT (TCMT IO) Term]
-> [NamesT (TCMT IO) Term] -> [NamesT (TCMT IO) Term]
forall a. [a] -> [a] -> [a]
++ [NamesT (TCMT IO) Term]
Vars (TCMT IO)
d)

    xTel <- (Telescope -> NamesT (TCMT IO) (NamesT (TCMT IO) Telescope)
forall (m :: * -> *) a.
(Monad m, Subst a) =>
a -> NamesT m (NamesT m a)
open (Telescope -> NamesT (TCMT IO) (NamesT (TCMT IO) Telescope))
-> NamesT (TCMT IO) Telescope
-> NamesT (TCMT IO) (NamesT (TCMT IO) Telescope)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (NamesT (TCMT IO) Telescope
 -> NamesT (TCMT IO) (NamesT (TCMT IO) Telescope))
-> NamesT (TCMT IO) Telescope
-> NamesT (TCMT IO) (NamesT (TCMT IO) Telescope)
forall a b. (a -> b) -> a -> b
$ AbsN Telescope -> NamesT (TCMT IO) (AbsN Telescope)
forall a. a -> NamesT (TCMT IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure AbsN Telescope
xTel NamesT (TCMT IO) (AbsN Telescope)
-> [NamesT (TCMT IO) (SubstArg Telescope)]
-> NamesT (TCMT IO) Telescope
forall (m :: * -> *) a.
(Monad m, Subst a) =>
NamesT m (AbsN a) -> [NamesT m (SubstArg a)] -> NamesT m a
`applyN` [NamesT (TCMT IO) Term]
[NamesT (TCMT IO) (SubstArg Telescope)]
Vars (TCMT IO)
g1
    q4_f <- (open =<<) $ bind "i" $ \ Var (TCMT IO)
i -> 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
$ ShortText
-> (Var (TCMT IO) -> NamesT (TCMT IO) [Term])
-> NamesT (TCMT IO) (Abs [Term])
forall (m :: * -> *) a.
Monad m =>
ShortText
-> ((forall b. (Subst b, DeBruijn b) => NamesT m b) -> NamesT m a)
-> NamesT m (Abs a)
bind ShortText
"j" ((Var (TCMT IO) -> NamesT (TCMT IO) [Term])
 -> NamesT (TCMT IO) (Abs [Term]))
-> (Var (TCMT IO) -> NamesT (TCMT IO) [Term])
-> NamesT (TCMT IO) (Abs [Term])
forall a b. (a -> b) -> a -> b
$ \ Var (TCMT IO)
j -> do
      ty <- ShortText
-> (Var (TCMT IO) -> NamesT (TCMT IO) Telescope)
-> NamesT (TCMT IO) (Abs Telescope)
forall (m :: * -> *) a.
Monad m =>
ShortText
-> ((forall b. (Subst b, DeBruijn b) => NamesT m b) -> NamesT m a)
-> NamesT m (Abs a)
bind ShortText
"i" ((Var (TCMT IO) -> NamesT (TCMT IO) Telescope)
 -> NamesT (TCMT IO) (Abs Telescope))
-> (Var (TCMT IO) -> NamesT (TCMT IO) Telescope)
-> NamesT (TCMT IO) (Abs Telescope)
forall a b. (a -> b) -> a -> b
$ \ Var (TCMT IO)
_ -> NamesT (TCMT IO) Telescope
xTel
      face <- max phi $ max (neg j) (neg i)
      base <- map defaultArg <$> appTel (sequence q) j
      u  <- liftM2 (,) (max j psi) $ bind "h" $ \ Var (TCMT IO)
h -> do
              NamesT (TCMT IO) [Term]
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) [Term]
forall (m :: * -> *).
Monad m =>
NamesT m [Term] -> NamesT m Term -> NamesT m [Term]
appTel ([NamesT (TCMT IO) Term] -> NamesT (TCMT IO) [Term]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence [NamesT (TCMT IO) Term]
Vars (TCMT IO)
p) (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
Var (TCMT IO)
j (NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall {m :: * -> *}.
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
NamesT m Term -> NamesT m Term -> NamesT m Term
min NamesT (TCMT IO) Term
Var (TCMT IO)
h NamesT (TCMT IO) Term
Var (TCMT IO)
i))
      xs <- fromRight __IMPOSSIBLE__ <$> do lift $ runExceptT $ transpSysTel' False ty [u] face base
      pure $ map unArg xs
    -- Ξ ⊢ pat_rec[0] = pat : D η v
    -- Ξ ⊢ pat_rec[1] = trX q4 (φ ∧ ψ) x0 : D η v
    -- Ξ ⊢ pat-rec[i] := trX (\ j → p (i ∨ j)) (i ∨ φ) (trX (q4_f i) (ψ ∧ (φ ∨ ~ i)) t)
    pat_rec <- (open =<<) $ bind "i" $ \ Var (TCMT IO)
i -> do
          p_conn <- ((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
$ ShortText
-> (Var (TCMT IO) -> NamesT (TCMT IO) [Term])
-> NamesT (TCMT IO) (Abs [Term])
forall (m :: * -> *) a.
Monad m =>
ShortText
-> ((forall b. (Subst b, DeBruijn b) => NamesT m b) -> NamesT m a)
-> NamesT m (Abs a)
bind ShortText
"i" ((Var (TCMT IO) -> NamesT (TCMT IO) [Term])
 -> NamesT (TCMT IO) (Abs [Term]))
-> (Var (TCMT IO) -> NamesT (TCMT IO) [Term])
-> NamesT (TCMT IO) (Abs [Term])
forall a b. (a -> b) -> a -> b
$ \ Var (TCMT IO)
j -> [NamesT (TCMT IO) Term] -> NamesT (TCMT IO) [Term]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence [NamesT (TCMT IO) Term]
Vars (TCMT IO)
p NamesT (TCMT IO) [Term]
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) [Term]
forall (m :: * -> *).
Monad m =>
NamesT m [Term] -> NamesT m Term -> NamesT m [Term]
`appTel` NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall {m :: * -> *}.
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
NamesT m Term -> NamesT m Term -> NamesT m Term
max NamesT (TCMT IO) Term
Var (TCMT IO)
i NamesT (TCMT IO) Term
Var (TCMT IO)
j
          q4_f' <- (mapM open =<<) $ absApp <$> q4_f <*> i
          trX `applyN` g1 `applyN` (max i phi:p_conn)
              `applyN` [trX `applyN` g1 `applyN` (min psi (max phi (neg i)):q4_f') `applyN` [x0]]

    let mkBndry NamesT (TCMT IO) (Abs [Term])
args = do
            args1 <- ((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
$ (Abs [Term] -> Term -> [Term]
Abs [Term] -> SubstArg [Term] -> [Term]
forall a. Subst a => Abs a -> SubstArg a -> a
absApp (Abs [Term] -> Term -> [Term])
-> NamesT (TCMT IO) (Abs [Term])
-> NamesT (TCMT IO) (Term -> [Term])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamesT (TCMT IO) (Abs [Term])
args NamesT (TCMT IO) (Term -> [Term])
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) [Term]
forall a b.
NamesT (TCMT IO) (a -> b)
-> NamesT (TCMT IO) a -> NamesT (TCMT IO) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Term -> NamesT (TCMT IO) Term
forall a. a -> NamesT (TCMT IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
io)
            -- faces ought to be constant on "j"
            faces <- pure (fmap (map fst) old_sides) `applyN` args1
            us <- forM (mapM (map snd) old_sides) $ \ AbsN Term
u -> do
                  ShortText
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall (m :: * -> *).
Monad m =>
ShortText -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
lam ShortText
"j" ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
 -> NamesT (TCMT IO) Term)
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall a b. (a -> b) -> a -> b
$ \ NamesT (TCMT IO) Term
j -> ShortText
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall (m :: * -> *).
Monad m =>
ShortText -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
lam ShortText
"o" ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
 -> NamesT (TCMT IO) Term)
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall a b. (a -> b) -> a -> b
$ \ NamesT (TCMT IO) Term
_ -> do
                    args <- ((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
$ (Abs [Term] -> Term -> [Term]
Abs [Term] -> SubstArg [Term] -> [Term]
forall a. Subst a => Abs a -> SubstArg a -> a
absApp (Abs [Term] -> Term -> [Term])
-> NamesT (TCMT IO) (Abs [Term])
-> NamesT (TCMT IO) (Term -> [Term])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamesT (TCMT IO) (Abs [Term])
args NamesT (TCMT IO) (Term -> [Term])
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) [Term]
forall a b.
NamesT (TCMT IO) (a -> b)
-> NamesT (TCMT IO) a -> NamesT (TCMT IO) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> NamesT (TCMT IO) Term
j)
                    pure u `applyN` args
            forM (zip faces us) $ \ (Term
phi,Term
u) -> (NamesT (TCMT IO) Term
 -> NamesT (TCMT IO) Term
 -> (NamesT (TCMT IO) Term, NamesT (TCMT IO) Term))
-> NamesT (TCMT IO) (NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) (NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) (NamesT (TCMT IO) Term, NamesT (TCMT IO) Term)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (,) (Term -> NamesT (TCMT IO) (NamesT (TCMT IO) Term)
forall (m :: * -> *) a.
(Monad m, Subst a) =>
a -> NamesT m (NamesT m a)
open Term
phi) (Term -> NamesT (TCMT IO) (NamesT (TCMT IO) Term)
forall (m :: * -> *) a.
(Monad m, Subst a) =>
a -> NamesT m (NamesT m a)
open Term
u)
    let mkComp NamesT (TCMT IO) (AbsN Term)
pr = ShortText
-> (Var (TCMT IO) -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) (Abs Term)
forall (m :: * -> *) a.
Monad m =>
ShortText
-> ((forall b. (Subst b, DeBruijn b) => NamesT m b) -> NamesT m a)
-> NamesT m (Abs a)
bind ShortText
"i" ((Var (TCMT IO) -> NamesT (TCMT IO) Term)
 -> NamesT (TCMT IO) (Abs Term))
-> (Var (TCMT IO) -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) (Abs Term)
forall a b. (a -> b) -> a -> b
$ \ Var (TCMT IO)
i -> do
          d_f <- (Abs [Term] -> NamesT (TCMT IO) (NamesT (TCMT IO) (Abs [Term]))
forall (m :: * -> *) a.
(Monad m, Subst a) =>
a -> NamesT m (NamesT m a)
open (Abs [Term] -> NamesT (TCMT IO) (NamesT (TCMT IO) (Abs [Term])))
-> NamesT (TCMT IO) (Abs [Term])
-> NamesT (TCMT IO) (NamesT (TCMT IO) (Abs [Term]))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (NamesT (TCMT IO) (Abs [Term])
 -> NamesT (TCMT IO) (NamesT (TCMT IO) (Abs [Term])))
-> NamesT (TCMT IO) (Abs [Term])
-> NamesT (TCMT IO) (NamesT (TCMT IO) (Abs [Term]))
forall a b. (a -> b) -> a -> b
$ ShortText
-> (Var (TCMT IO) -> NamesT (TCMT IO) [Term])
-> NamesT (TCMT IO) (Abs [Term])
forall (m :: * -> *) a.
Monad m =>
ShortText
-> ((forall b. (Subst b, DeBruijn b) => NamesT m b) -> NamesT m a)
-> NamesT m (Abs a)
bind ShortText
"j" ((Var (TCMT IO) -> NamesT (TCMT IO) [Term])
 -> NamesT (TCMT IO) (Abs [Term]))
-> (Var (TCMT IO) -> NamesT (TCMT IO) [Term])
-> NamesT (TCMT IO) (Abs [Term])
forall a b. (a -> b) -> a -> b
$ \ Var (TCMT IO)
j -> do
            tel <- ShortText
-> (Var (TCMT IO) -> NamesT (TCMT IO) Telescope)
-> NamesT (TCMT IO) (Abs Telescope)
forall (m :: * -> *) a.
Monad m =>
ShortText
-> ((forall b. (Subst b, DeBruijn b) => NamesT m b) -> NamesT m a)
-> NamesT m (Abs a)
bind ShortText
"j" ((Var (TCMT IO) -> NamesT (TCMT IO) Telescope)
 -> NamesT (TCMT IO) (Abs Telescope))
-> (Var (TCMT IO) -> NamesT (TCMT IO) Telescope)
-> NamesT (TCMT IO) (Abs Telescope)
forall a b. (a -> b) -> a -> b
$ \ Var (TCMT IO)
j -> NamesT (TCMT IO) (AbsN Telescope)
delta NamesT (TCMT IO) (AbsN Telescope)
-> [NamesT (TCMT IO) (SubstArg Telescope)]
-> NamesT (TCMT IO) Telescope
forall (m :: * -> *) a.
(Monad m, Subst a) =>
NamesT m (AbsN a) -> [NamesT m (SubstArg a)] -> NamesT m a
`applyN` ([NamesT (TCMT IO) Term]
Vars (TCMT IO)
g1 [NamesT (TCMT IO) Term]
-> [NamesT (TCMT IO) Term] -> [NamesT (TCMT IO) Term]
forall a. [a] -> [a] -> [a]
++ [NamesT (TCMT IO) (AbsN Term)
pr NamesT (TCMT IO) (AbsN Term)
-> [NamesT (TCMT IO) (SubstArg Term)] -> NamesT (TCMT IO) Term
forall (m :: * -> *) a.
(Monad m, Subst a) =>
NamesT m (AbsN a) -> [NamesT m (SubstArg a)] -> NamesT m a
`applyN` [NamesT (TCMT IO) Term
NamesT (TCMT IO) (SubstArg Term)
Var (TCMT IO)
i,NamesT (TCMT IO) Term
NamesT (TCMT IO) (SubstArg Term)
Var (TCMT IO)
j]])
            face <- min phi psi `max` (min i (max phi psi))
            j <- j
            d <- map defaultArg <$> sequence d
            lift $ covFillTele f tel face d j
          let args = ShortText
-> (Var (TCMT IO) -> NamesT (TCMT IO) [Term])
-> NamesT (TCMT IO) (Abs [Term])
forall (m :: * -> *) a.
Monad m =>
ShortText
-> ((forall b. (Subst b, DeBruijn b) => NamesT m b) -> NamesT m a)
-> NamesT m (Abs a)
bind ShortText
"j" ((Var (TCMT IO) -> NamesT (TCMT IO) [Term])
 -> NamesT (TCMT IO) (Abs [Term]))
-> (Var (TCMT IO) -> NamesT (TCMT IO) [Term])
-> NamesT (TCMT IO) (Abs [Term])
forall a b. (a -> b) -> a -> b
$ \ Var (TCMT IO)
j -> do
                g1 <- [NamesT (TCMT IO) Term] -> NamesT (TCMT IO) [Term]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence [NamesT (TCMT IO) Term]
Vars (TCMT IO)
g1
                x <- pr `applyN` [i,neg j]
                ys <- absApp <$> d_f <*> neg j
                pure $ g1 ++ x:ys
          ty <- (open =<<) $ bind "j" $ \ Var (TCMT IO)
j -> do
               args <- ((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
$ Abs [Term] -> Term -> [Term]
Abs [Term] -> SubstArg [Term] -> [Term]
forall a. Subst a => Abs a -> SubstArg a -> a
absApp (Abs [Term] -> Term -> [Term])
-> NamesT (TCMT IO) (Abs [Term])
-> NamesT (TCMT IO) (Term -> [Term])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamesT (TCMT IO) (Abs [Term])
args NamesT (TCMT IO) (Term -> [Term])
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) [Term]
forall a b.
NamesT (TCMT IO) (a -> b)
-> NamesT (TCMT IO) a -> NamesT (TCMT IO) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> NamesT (TCMT IO) Term
Var (TCMT IO)
j
               fmap unDom $ old_ty `applyN` args
          let face = NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall {m :: * -> *}.
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
NamesT m Term -> NamesT m Term -> NamesT m Term
max NamesT (TCMT IO) Term
Var (TCMT IO)
i (NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall {m :: * -> *}.
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
NamesT m Term -> NamesT m Term -> NamesT m Term
min NamesT (TCMT IO) Term
Var (TCMT IO)
phi NamesT (TCMT IO) Term
Var (TCMT IO)
psi)
          base <- (open =<<) $ do
            args' <- (mapM open =<<) $ absApp <$> args <*> pure iz
            fmap (Def f) $ (fmap patternsToElims <$> old_ps) `applyN` args'
          sys <- mkBndry args
          transpSys ty sys face base

    -- Ξ ⊢ δ_f[1] = tr (i. Δ[γ1,x = pat_rec[i]]) (φ ∧ ψ) δ
    -- Ξ ⊢ w0 := f old_ps[γ1,x = pat_rec[1] ,δ_f[1]] : old_t[γ1,x = pat_rec[1],δ_f[1]]
    -- Ξ ⊢ rhs := tr (i. old_t[γ1,x = pat_rec[~i], δ_f[~i]]) (φ ∧ ψ) w0 -- TODO plus sides.
    syspsi <- (open =<<) $ lam "i" $ \ NamesT (TCMT IO) Term
i -> ShortText
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall (m :: * -> *).
Monad m =>
ShortText -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
lam ShortText
"o" ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
 -> NamesT (TCMT IO) Term)
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall a b. (a -> b) -> a -> b
$ \ NamesT (TCMT IO) Term
_ -> do
      c <- NamesT (TCMT IO) (AbsN Term) -> NamesT (TCMT IO) (Abs Term)
mkComp (NamesT (TCMT IO) (AbsN Term) -> NamesT (TCMT IO) (Abs Term))
-> NamesT (TCMT IO) (AbsN Term) -> NamesT (TCMT IO) (Abs Term)
forall a b. (a -> b) -> a -> b
$ [ShortText]
-> (Vars (TCMT IO) -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) (AbsN Term)
forall (m :: * -> *) a.
Monad m =>
[ShortText] -> (Vars m -> NamesT m a) -> NamesT m (AbsN a)
bindN [ShortText
"i",ShortText
"j"] ((Vars (TCMT IO) -> NamesT (TCMT IO) Term)
 -> NamesT (TCMT IO) (AbsN Term))
-> (Vars (TCMT IO) -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) (AbsN Term)
forall a b. (a -> b) -> a -> b
$ \ [NamesT (TCMT IO) Term
i,NamesT (TCMT IO) Term
j] -> do
        res <- ShortText
-> (Var (TCMT IO) -> NamesT (TCMT IO) (Type, [Term]))
-> NamesT (TCMT IO) (Abs (Type, [Term]))
forall (m :: * -> *) a.
Monad m =>
ShortText
-> ((forall b. (Subst b, DeBruijn b) => NamesT m b) -> NamesT m a)
-> NamesT m (Abs a)
bind ShortText
"k" ((Var (TCMT IO) -> NamesT (TCMT IO) (Type, [Term]))
 -> NamesT (TCMT IO) (Abs (Type, [Term])))
-> (Var (TCMT IO) -> NamesT (TCMT IO) (Type, [Term]))
-> NamesT (TCMT IO) (Abs (Type, [Term]))
forall a b. (a -> b) -> a -> b
$ \ Var (TCMT IO)
k -> do
          let phi_k :: NamesT (TCMT IO) Term
phi_k = NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall {m :: * -> *}.
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
NamesT m Term -> NamesT m Term -> NamesT m Term
max NamesT (TCMT IO) Term
Var (TCMT IO)
phi (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
neg NamesT (TCMT IO) Term
Var (TCMT IO)
k)
          let p_k :: [NamesT (TCMT IO) Term]
p_k = [NamesT (TCMT IO) Term]
Vars (TCMT IO)
p [NamesT (TCMT IO) Term]
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> [NamesT (TCMT IO) Term]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \ NamesT (TCMT IO) Term
p -> ShortText
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall (m :: * -> *).
Monad m =>
ShortText -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
lam ShortText
"h" ((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
h -> NamesT (TCMT IO) Term
p NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> (NamesT (TCMT IO) Term
-> 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
Var (TCMT IO)
k NamesT (TCMT IO) Term
h)
          data_ty <- AbsN (AbsN Type) -> NamesT (TCMT IO) (AbsN (AbsN Type))
forall a. a -> NamesT (TCMT IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure AbsN (AbsN Type)
dT NamesT (TCMT IO) (AbsN (AbsN Type))
-> [NamesT (TCMT IO) (SubstArg (AbsN Type))]
-> NamesT (TCMT IO) (AbsN Type)
forall (m :: * -> *) a.
(Monad m, Subst a) =>
NamesT m (AbsN a) -> [NamesT m (SubstArg a)] -> NamesT m a
`applyN` [NamesT (TCMT IO) Term]
[NamesT (TCMT IO) (SubstArg (AbsN Type))]
Vars (TCMT IO)
g1 NamesT (TCMT IO) (AbsN Type)
-> [NamesT (TCMT IO) (SubstArg Type)] -> NamesT (TCMT IO) Type
forall (m :: * -> *) a.
(Monad m, Subst a) =>
NamesT m (AbsN a) -> [NamesT m (SubstArg a)] -> NamesT m a
`applyN` ([NamesT (TCMT IO) Term]
Vars (TCMT IO)
p [NamesT (TCMT IO) Term]
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> [NamesT (TCMT IO) Term]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \ NamesT (TCMT IO) Term
p -> NamesT (TCMT IO) Term
p NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT (TCMT IO) Term
Var (TCMT IO)
k)
          line1 <- trX `applyN` g1 `applyN` (phi_k:p_k) `applyN` [x0]

          line2 <- trX `applyN` g1
                       `applyN` (max phi_k j      : p_k <&> (\ NamesT (TCMT IO) Term
p -> ShortText
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall (m :: * -> *).
Monad m =>
ShortText -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
lam ShortText
"h" ((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
h -> NamesT (TCMT IO) Term
p NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> (NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall {m :: * -> *}.
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
NamesT m Term -> NamesT m Term -> NamesT m Term
max NamesT (TCMT IO) Term
h NamesT (TCMT IO) Term
j)))
                       `applyN`
                  [trX `applyN` g1
                       `applyN` (max phi_k (neg j): p_k <&> (\ NamesT (TCMT IO) Term
p -> ShortText
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall (m :: * -> *).
Monad m =>
ShortText -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
lam ShortText
"h" ((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
h -> NamesT (TCMT IO) Term
p NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> (NamesT (TCMT IO) Term
-> 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
h NamesT (TCMT IO) Term
j)))
                       `applyN` [x0]]
          pure (data_ty, [line1, line2])
        case res of
          Abs ShortText
n (Type
data_ty, [Term
line1, Term
line2]) -> do
            data_ty <- Abs Type -> NamesT (TCMT IO) (NamesT (TCMT IO) (Abs Type))
forall (m :: * -> *) a.
(Monad m, Subst a) =>
a -> NamesT m (NamesT m a)
open (Abs Type -> NamesT (TCMT IO) (NamesT (TCMT IO) (Abs Type)))
-> Abs Type -> NamesT (TCMT IO) (NamesT (TCMT IO) (Abs Type))
forall a b. (a -> b) -> a -> b
$ ShortText -> Type -> Abs Type
forall a. ShortText -> a -> Abs a
Abs ShortText
n Type
data_ty
            line1   <- open $ Abs n line1
            line2   <- open $ Abs n line2
            let sys = [(NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
neg NamesT (TCMT IO) Term
i, ShortText
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall (m :: * -> *).
Monad m =>
ShortText -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
lam ShortText
"k" ((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
k -> ShortText
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall (m :: * -> *).
Monad m =>
ShortText -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
lam ShortText
"o" ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
 -> NamesT (TCMT IO) Term)
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall a b. (a -> b) -> a -> b
$ \ NamesT (TCMT IO) Term
_ -> Abs Term -> Term -> Term
Abs Term -> SubstArg Term -> Term
forall a. Subst a => Abs a -> SubstArg a -> a
absApp (Abs Term -> Term -> Term)
-> NamesT (TCMT IO) (Abs Term) -> NamesT (TCMT IO) (Term -> Term)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamesT (TCMT IO) (Abs Term)
line2 NamesT (TCMT IO) (Term -> Term)
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall a b.
NamesT (TCMT IO) (a -> b)
-> NamesT (TCMT IO) a -> NamesT (TCMT IO) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> NamesT (TCMT IO) Term
k)
                      ,(NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
neg NamesT (TCMT IO) Term
j NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall {m :: * -> *}.
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
NamesT m Term -> NamesT m Term -> NamesT m Term
`max` NamesT (TCMT IO) Term
j NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall {m :: * -> *}.
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
NamesT m Term -> NamesT m Term -> NamesT m Term
`max` NamesT (TCMT IO) Term
i NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall {m :: * -> *}.
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
NamesT m Term -> NamesT m Term -> NamesT m Term
`max` NamesT (TCMT IO) Term
Var (TCMT IO)
phi, ShortText
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall (m :: * -> *).
Monad m =>
ShortText -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
lam ShortText
"k" ((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
k -> ShortText
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall (m :: * -> *).
Monad m =>
ShortText -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
lam ShortText
"o" ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
 -> NamesT (TCMT IO) Term)
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall a b. (a -> b) -> a -> b
$ \ NamesT (TCMT IO) Term
_ -> Abs Term -> Term -> Term
Abs Term -> SubstArg Term -> Term
forall a. Subst a => Abs a -> SubstArg a -> a
absApp (Abs Term -> Term -> Term)
-> NamesT (TCMT IO) (Abs Term) -> NamesT (TCMT IO) (Term -> Term)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamesT (TCMT IO) (Abs Term)
line1 NamesT (TCMT IO) (Term -> Term)
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall a b.
NamesT (TCMT IO) (a -> b)
-> NamesT (TCMT IO) a -> NamesT (TCMT IO) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> NamesT (TCMT IO) Term
k)
                      ]
            transpSys data_ty sys (pure iz) x0
          Abs (Type, [Term])
_ -> NamesT (TCMT IO) Term
forall a. HasCallStack => a
__IMPOSSIBLE__
      absApp <$> pure c <*> i
    sysphi <- (open =<<) $ lam "i" $ \ NamesT (TCMT IO) Term
i -> ShortText
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall (m :: * -> *).
Monad m =>
ShortText -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
lam ShortText
"o" ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
 -> NamesT (TCMT IO) Term)
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall a b. (a -> b) -> a -> b
$ \ NamesT (TCMT IO) Term
o -> do
      c <- NamesT (TCMT IO) (AbsN Term) -> NamesT (TCMT IO) (Abs Term)
mkComp (NamesT (TCMT IO) (AbsN Term) -> NamesT (TCMT IO) (Abs Term))
-> NamesT (TCMT IO) (AbsN Term) -> NamesT (TCMT IO) (Abs Term)
forall a b. (a -> b) -> a -> b
$ [ShortText]
-> (Vars (TCMT IO) -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) (AbsN Term)
forall (m :: * -> *) a.
Monad m =>
[ShortText] -> (Vars m -> NamesT m a) -> NamesT m (AbsN a)
bindN [ShortText
"i",ShortText
"j"] ((Vars (TCMT IO) -> NamesT (TCMT IO) Term)
 -> NamesT (TCMT IO) (AbsN Term))
-> (Vars (TCMT IO) -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) (AbsN Term)
forall a b. (a -> b) -> a -> b
$ \ Vars (TCMT IO)
_ij -> do
        NamesT (TCMT IO) (AbsN (AbsN (AbsN Term)))
trX NamesT (TCMT IO) (AbsN (AbsN (AbsN Term)))
-> [NamesT (TCMT IO) (SubstArg (AbsN (AbsN Term)))]
-> NamesT (TCMT IO) (AbsN (AbsN Term))
forall (m :: * -> *) a.
(Monad m, Subst a) =>
NamesT m (AbsN a) -> [NamesT m (SubstArg a)] -> NamesT m a
`applyN` [NamesT (TCMT IO) Term]
[NamesT (TCMT IO) (SubstArg (AbsN (AbsN Term)))]
Vars (TCMT IO)
g1 NamesT (TCMT IO) (AbsN (AbsN Term))
-> [NamesT (TCMT IO) (SubstArg (AbsN Term))]
-> NamesT (TCMT IO) (AbsN Term)
forall (m :: * -> *) a.
(Monad m, Subst a) =>
NamesT m (AbsN a) -> [NamesT m (SubstArg a)] -> NamesT m a
`applyN` (NamesT (TCMT IO) Term
Var (TCMT IO)
psiNamesT (TCMT IO) Term
-> [NamesT (TCMT IO) Term] -> [NamesT (TCMT IO) Term]
forall a. a -> [a] -> [a]
:[NamesT (TCMT IO) Term]
Vars (TCMT IO)
q) NamesT (TCMT IO) (AbsN Term)
-> [NamesT (TCMT IO) (SubstArg Term)] -> NamesT (TCMT IO) Term
forall (m :: * -> *) a.
(Monad m, Subst a) =>
NamesT m (AbsN a) -> [NamesT m (SubstArg a)] -> NamesT m a
`applyN` [NamesT (TCMT IO) Term
NamesT (TCMT IO) (SubstArg Term)
Var (TCMT IO)
x0]
      absApp <$> pure c <*> i
    syse <- mkBndry $ bind "j" $ \ Var (TCMT IO)
_ -> [NamesT (TCMT IO) Term] -> NamesT (TCMT IO) [Term]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence ([NamesT (TCMT IO) Term] -> NamesT (TCMT IO) [Term])
-> [NamesT (TCMT IO) Term] -> NamesT (TCMT IO) [Term]
forall a b. (a -> b) -> a -> b
$ [NamesT (TCMT IO) Term]
Vars (TCMT IO)
g1 [NamesT (TCMT IO) Term]
-> [NamesT (TCMT IO) Term] -> [NamesT (TCMT IO) Term]
forall a. [a] -> [a] -> [a]
++ [Abs Term -> Term -> Term
Abs Term -> SubstArg Term -> Term
forall a. Subst a => Abs a -> SubstArg a -> a
absApp (Abs Term -> Term -> Term)
-> NamesT (TCMT IO) (Abs Term) -> NamesT (TCMT IO) (Term -> Term)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamesT (TCMT IO) (Abs Term)
pat_rec NamesT (TCMT IO) (Term -> Term)
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall a b.
NamesT (TCMT IO) (a -> b)
-> NamesT (TCMT IO) a -> NamesT (TCMT IO) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Term -> NamesT (TCMT IO) Term
forall a. a -> NamesT (TCMT IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
iz] [NamesT (TCMT IO) Term]
-> [NamesT (TCMT IO) Term] -> [NamesT (TCMT IO) Term]
forall a. [a] -> [a] -> [a]
++ [NamesT (TCMT IO) Term]
Vars (TCMT IO)
d
    let sys = [(NamesT (TCMT IO) Term, NamesT (TCMT IO) Term)]
syse [(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. [a] -> [a] -> [a]
++ [(NamesT (TCMT IO) Term
Var (TCMT IO)
phi,NamesT (TCMT IO) Term
sysphi)] [(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. [a] -> [a] -> [a]
++ [(NamesT (TCMT IO) Term
Var (TCMT IO)
psi,NamesT (TCMT IO) Term
syspsi)]

    w0 <- (open =<<) $ do
      let w = NamesT (TCMT IO) (AbsN Term) -> NamesT (TCMT IO) (Abs Term)
mkComp ([ShortText]
-> (Vars (TCMT IO) -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) (AbsN Term)
forall (m :: * -> *) a.
Monad m =>
[ShortText] -> (Vars m -> NamesT m a) -> NamesT m (AbsN a)
bindN [ShortText
"i",ShortText
"j"] ((Vars (TCMT IO) -> NamesT (TCMT IO) Term)
 -> NamesT (TCMT IO) (AbsN Term))
-> (Vars (TCMT IO) -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) (AbsN Term)
forall a b. (a -> b) -> a -> b
$ \ [NamesT (TCMT IO) Term
_i, NamesT (TCMT IO) Term
j] -> Abs Term -> Term -> Term
Abs Term -> SubstArg Term -> Term
forall a. Subst a => Abs a -> SubstArg a -> a
absApp (Abs Term -> Term -> Term)
-> NamesT (TCMT IO) (Abs Term) -> NamesT (TCMT IO) (Term -> Term)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamesT (TCMT IO) (Abs Term)
pat_rec NamesT (TCMT IO) (Term -> Term)
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall a b.
NamesT (TCMT IO) (a -> b)
-> NamesT (TCMT IO) a -> NamesT (TCMT IO) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> NamesT (TCMT IO) Term
j)
      absApp <$> w <*> pure iz

    hcomp (unDom <$> rhsTy) sys w0 >>= \case
      Left Type
ty -> do
        ps <- NamesT (TCMT IO) [NamedArg DeBruijnPattern]
ps
        liftTCM $ addContext cTel do
          cty <- buildClosure $ NoAbs "i" ty
          typeError $ CannotCreateMissingClause f (cTel, ps) "Cannot compose against result type:" cty
      Right Term
rhs -> (,,) ([NamedArg DeBruijnPattern]
 -> Dom Type
 -> Term
 -> ([NamedArg DeBruijnPattern], Dom Type, Term))
-> NamesT (TCMT IO) [NamedArg DeBruijnPattern]
-> NamesT
     (TCMT IO)
     (Dom Type -> Term -> ([NamedArg DeBruijnPattern], Dom Type, Term))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamesT (TCMT IO) [NamedArg DeBruijnPattern]
ps NamesT
  (TCMT IO)
  (Dom Type -> Term -> ([NamedArg DeBruijnPattern], Dom Type, Term))
-> NamesT (TCMT IO) (Dom Type)
-> NamesT
     (TCMT IO) (Term -> ([NamedArg DeBruijnPattern], Dom Type, Term))
forall a b.
NamesT (TCMT IO) (a -> b)
-> NamesT (TCMT IO) a -> NamesT (TCMT IO) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> NamesT (TCMT IO) (Dom Type)
rhsTy NamesT
  (TCMT IO) (Term -> ([NamedArg DeBruijnPattern], Dom Type, Term))
-> NamesT (TCMT IO) Term
-> NamesT (TCMT IO) ([NamedArg DeBruijnPattern], Dom Type, Term)
forall a b.
NamesT (TCMT IO) (a -> b)
-> NamesT (TCMT IO) a -> NamesT (TCMT IO) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Term -> NamesT (TCMT IO) Term
forall a. a -> NamesT (TCMT IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
rhs

  let (ps,ty,rhs) = unAbsN $ unAbs $ unAbsN $ unAbs $ unAbsN $ unAbs $ unAbsN $ ps_ty_rhs

  reportSDoc "tc.cover.trx.trx" 20 $ "trX-trX clause for" <+> prettyTCM f
  let c = Clause { clauseLHSRange :: Range
clauseLHSRange  = Range
forall a. Range' a
noRange
                 , clauseFullRange :: Range
clauseFullRange = Range
forall a. Range' a
noRange
                 , clauseTel :: Telescope
clauseTel       = Telescope
cTel
                 , namedClausePats :: [NamedArg DeBruijnPattern]
namedClausePats = [NamedArg DeBruijnPattern]
ps
                 , clauseBody :: Maybe Term
clauseBody      = Term -> Maybe Term
forall a. a -> Maybe a
Just Term
rhs
                 , clauseType :: Maybe (Arg Type)
clauseType      = Arg Type -> Maybe (Arg Type)
forall a. a -> Maybe a
Just (Arg Type -> Maybe (Arg Type)) -> Arg Type -> Maybe (Arg Type)
forall a b. (a -> b) -> a -> b
$ ArgInfo -> Type -> Arg Type
forall e. ArgInfo -> e -> Arg e
Arg (Dom Type -> ArgInfo
forall a. LensArgInfo a => a -> ArgInfo
getArgInfo Dom Type
ty) (Dom Type -> Type
forall t e. Dom' t e -> e
unDom Dom Type
ty)
                 , clauseCatchall :: Catchall
clauseCatchall    = Catchall
forall a. Null a => a
empty
                 , clauseRecursive :: ClauseRecursive
clauseRecursive   = ClauseRecursive
YesRecursive
                 , clauseUnreachable :: Maybe Bool
clauseUnreachable = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False
                 , clauseEllipsis :: ExpandedEllipsis
clauseEllipsis    = ExpandedEllipsis
NoEllipsis
                 , clauseWhereModule :: Maybe ModuleName
clauseWhereModule = Maybe ModuleName
forall a. Maybe a
Nothing
                 }
  debugClause "tc.cover.trx.trx" c
  return $ c

createMissingTrXHCompClause ::
     QName
  -> QName
  -> Arg Nat
  -> BlockingVar
  -> SplitClause
  -> TCM Clause
createMissingTrXHCompClause :: QName
-> QName -> Arg Int -> BlockingVar -> SplitClause -> TCM Clause
createMissingTrXHCompClause QName
q_trX QName
f Arg Int
n BlockingVar
x SplitClause
old_sc = do
  let
    old_tel :: Telescope
old_tel = SplitClause -> Telescope
scTel SplitClause
old_sc
    old_ps :: [NamedArg DeBruijnPattern]
old_ps = [NamedArg SplitPattern] -> [NamedArg DeBruijnPattern]
fromSplitPatterns ([NamedArg SplitPattern] -> [NamedArg DeBruijnPattern])
-> [NamedArg SplitPattern] -> [NamedArg DeBruijnPattern]
forall a b. (a -> b) -> a -> b
$ SplitClause -> [NamedArg SplitPattern]
scPats SplitClause
old_sc
    old_t :: Dom Type
old_t = Dom Type -> Maybe (Dom Type) -> Dom Type
forall a. a -> Maybe a -> a
fromMaybe Dom Type
forall a. HasCallStack => a
__IMPOSSIBLE__ (Maybe (Dom Type) -> Dom Type) -> Maybe (Dom Type) -> Dom Type
forall a b. (a -> b) -> a -> b
$ SplitClause -> Maybe (Dom Type)
scTarget SplitClause
old_sc
    cannotCreate :: MonadTCError m => Doc -> Closure (Abs Type) -> m a
    cannotCreate :: forall (m :: * -> *) a.
MonadTCError m =>
Doc -> Closure (Abs Type) -> m a
cannotCreate Doc
doc Closure (Abs Type)
t = do
      SplitError -> m a
forall (m :: * -> *) e a.
(HasCallStack, MonadTCError m, Diagnostic e) =>
e -> m a
typeError (SplitError -> m a) -> SplitError -> m a
forall a b. (a -> b) -> a -> b
$ QName
-> (Telescope, [NamedArg DeBruijnPattern])
-> Doc
-> Closure (Abs Type)
-> SplitError
CannotCreateMissingClause QName
f (Telescope
old_tel, [NamedArg DeBruijnPattern]
old_ps) Doc
doc Closure (Abs Type)
t

  VerboseKey -> Int -> TCMT IO Doc -> TCMT IO ()
forall (m :: * -> *).
MonadDebug m =>
VerboseKey -> Int -> TCMT IO Doc -> m ()
reportSDoc VerboseKey
"tc.cover.trx.hcomp" Int
20 (TCMT IO Doc -> TCMT IO ()) -> TCMT IO Doc -> TCMT IO ()
forall a b. (a -> b) -> a -> b
$ TCMT IO Doc
"trX-hcomp clause for" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> QName -> TCMT IO Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
forall (m :: * -> *). MonadPretty m => QName -> m Doc
prettyTCM QName
f
  VerboseKey -> Int -> TCMT IO Doc -> TCMT IO ()
forall (m :: * -> *).
MonadDebug m =>
VerboseKey -> Int -> TCMT IO Doc -> m ()
reportSDoc VerboseKey
"tc.cover.trx.hcomp" Int
20 (TCMT IO Doc -> TCMT IO ()) -> TCMT IO Doc -> TCMT IO ()
forall a b. (a -> b) -> a -> b
$ Int -> TCMT IO Doc -> TCMT IO Doc
forall (m :: * -> *). Functor m => Int -> m Doc -> m Doc
nest Int
2 (TCMT IO Doc -> TCMT IO Doc) -> TCMT IO Doc -> TCMT IO Doc
forall a b. (a -> b) -> a -> b
$ [TCMT IO Doc] -> TCMT IO Doc
forall (m :: * -> *) (t :: * -> *).
(Applicative m, Foldable t) =>
t (m Doc) -> m Doc
vcat ([TCMT IO Doc] -> TCMT IO Doc) -> [TCMT IO Doc] -> TCMT IO Doc
forall a b. (a -> b) -> a -> b
$
    [ TCMT IO Doc
"old_tel:" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> Telescope -> TCMT IO Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
forall (m :: * -> *). MonadPretty m => Telescope -> m Doc
prettyTCM Telescope
old_tel
    , TCMT IO Doc
"old_ps :" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> Telescope -> TCMT IO Doc -> TCMT IO Doc
forall b (m :: * -> *) a.
(AddContext b, MonadAddContext m) =>
b -> m a -> m a
forall (m :: * -> *) a.
MonadAddContext m =>
Telescope -> m a -> m a
addContext Telescope
old_tel ([Elim] -> TCMT IO Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
forall (m :: * -> *). MonadPretty m => [Elim] -> m Doc
prettyTCM ([Elim] -> TCMT IO Doc) -> [Elim] -> TCMT IO Doc
forall a b. (a -> b) -> a -> b
$ [NamedArg DeBruijnPattern] -> [Elim]
patternsToElims [NamedArg DeBruijnPattern]
old_ps)
    , TCMT IO Doc
"old_t  :" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> Telescope -> TCMT IO Doc -> TCMT IO Doc
forall b (m :: * -> *) a.
(AddContext b, MonadAddContext m) =>
b -> m a -> m a
forall (m :: * -> *) a.
MonadAddContext m =>
Telescope -> m a -> m a
addContext Telescope
old_tel (Dom Type -> TCMT IO Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
forall (m :: * -> *). MonadPretty m => Dom Type -> m Doc
prettyTCM Dom Type
old_t)
    ]

  -- old_tel = Γ1, (x : D η v), Δ
  -- α = boundary(old_ps)
  -- Γ1, (x : D η v), Δ ⊢ f old_ps : old_t [ α ↦ (f old_ps)[α] ]

  -- α' = boundary(old_ps[x = pat])
  -- Γ1, φ : I, p : Path X(η) _ v, ψ : I, u : I -> [ψ] → D η (p i0), u0 : D η (p i0) ⊢ pat := trX p φ (hcomp ψ u u0) : D η v

  -- Ξ = Γ1, φ : I, p : Path X(η) _ v, ψ : I, u : ..., u0 : D η (p i0), Δ[x = pat]

  -- Ξ ⊢ w1 := f old_ps[γ1,x = pat,δ] : old_t[γ1,x = pat,δ] -- the case we are defining. can only be used if specialized.

  -- Ξ ⊢ rhs : old_t[γ1,x = pat,δ] [ α' ↦ w1[α']
                                -- , φ  ↦ w1[φ = i1, p = refl]   = f old_ps[γ1,x = hcomp ψ u u0    ,δ]
                                -- , ψ  ↦ w1[ψ = i1]             = f old_ps[γ1,x = trX p φ (u i1 _),δ]
                                -- ]

  -- Ξ ⊢ q2 := tr (i. Path X(η) (q i0) (p i)) φ q : Path X(η) (q i0) (p i1)
  -- Ξ ⊢ pat_rec[0] = pat : D η v
  -- Ξ ⊢ pat_rec[1] = trX q2 (φ ∧ ψ) x0 : D η v
  -- Ξ ⊢ pat-rec[i] := trX (\ j → q (i ∨ j)) (i ∨ φ) (trX (q2_f i) (ψ ∧ (φ ∨ ~ i)) t)

  -- Ξ ⊢ δ_f[1] = tr (i. Δ[γ1,x = pat_rec[i]]) (φ ∧ ψ) δ : Δ[γ1,x = pat_rec[1]]
  -- Ξ ⊢ w0 := f old_ps[γ1,x = pat_rec[1] ,δ_f[1]] : old_t[γ1,x = pat_rec[1],δ_f[1]]
  -- Ξ ⊢ rhs := tr (i. old_t[γ1,x = pat_rec[~i], δ_f[~i]]) (φ ∧ ψ) w0 -- TODO plus sides.

  q_hcomp <- QName -> Maybe QName -> QName
forall a. a -> Maybe a -> a
fromMaybe QName
forall a. HasCallStack => a
__IMPOSSIBLE__ (Maybe QName -> QName) -> TCMT IO (Maybe QName) -> TCMT IO QName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PrimitiveId -> TCMT IO (Maybe QName)
forall (m :: * -> *) a.
(HasBuiltins m, IsBuiltin a) =>
a -> m (Maybe QName)
getName' PrimitiveId
builtinHComp

  reportSDoc "tc.cover.trx.trx" 20 $ "trX-trX clause for" <+> prettyTCM f
  reportSDoc "tc.cover.trx.trx" 20 $ nest 2 $ vcat $
    [ "old_tel:" <+> prettyTCM old_tel
    , "old_ps :" <+> addContext old_tel (prettyTCM $ patternsToElims old_ps)
    , "old_t  :" <+> addContext old_tel (prettyTCM old_t)
    ]

  -- TODO: redo comments, the strategy changed.
  -- old_tel = Γ1, (x : D η v), Δ
  -- α = boundary(old_ps)
  -- Γ1, (x : D η v), Δ ⊢ f old_ps : old_t [ α ↦ (f old_ps)[α] ]

  -- α' = boundary(old_ps[x = pat])
  -- Γ1, φ : I, p : Path X(η) _ v, ψ : I, q : Path X(η) _ (p i0), x0 : D η (q i0) ⊢ pat := trX p φ (trX q ψ x0) : D η v

  -- Ξ = Γ1, φ : I, p : Path X(η) _ v, ψ : I, q : Path X(η) _ (p i0), x0 : D η (q i0), Δ[x = pat]

  -- Ξ ⊢ w1 := f old_ps[γ1,x = pat,δ] : old_t[γ1,x = pat,δ] -- the case we are defining. can only be used if specialized.

  -- Ξ ⊢ rhs : old_t[γ1,x = pat,δ] [ α' ↦ w1[α']
                                -- , φ  ↦ w1[φ = i1, p = refl]
                                -- , ψ  ↦ w1[ψ = i1, q = refl]
                                -- ]
  -- Ξ ⊢ q2 := tr (i. Path X(η) (q i0) (p i)) φ q : Path X(η) (q i0) (p i1)
  -- Ξ ⊢ pat_rec[0] = pat : D η v
  -- Ξ ⊢ pat_rec[1] = trX q2 (φ ∧ ψ) x0 : D η v
  -- Ξ ⊢ pat-rec[i] := trX (\ j → p (i ∨ j)) (i ∨ φ) (trX (q2_f i) (ψ ∧ (φ ∨ ~ i)) t)

  -- Ξ ⊢ δ_f[1] = tr (i. Δ[γ1,x = pat_rec[i]]) (φ ∧ ψ) δ
  -- Ξ ⊢ w0 := f old_ps[γ1,x = pat_rec[1] ,δ_f[1]] : old_t[γ1,x = pat_rec[1],δ_f[1]]
  -- Ξ ⊢ rhs := tr (i. old_t[γ1,x = pat_rec[~i], δ_f[~i]]) (φ ∧ ψ) w0 -- TODO plus sides.

  interval <- primIntervalType
  iz <- primIZero
  io <- primIOne
  tHComp <- primHComp
  tNeg <- primINeg
  let neg NamesT (TCMT IO) Term
i = Term -> NamesT (TCMT IO) Term
forall a. a -> NamesT (TCMT IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
tNeg 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
  let min NamesT m Term
i NamesT m Term
j = m Term -> NamesT m Term
forall (m :: * -> *) a. Monad m => m a -> NamesT m a
cl m Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primIMin NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT m Term
i NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT m Term
j
  let max NamesT m Term
i NamesT m Term
j = m Term -> NamesT m Term
forall (m :: * -> *) a. Monad m => m a -> NamesT m a
cl m Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primIMax NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT m Term
i NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT m Term
j
  let
    old_ps' = [ShortText]
-> [NamedArg DeBruijnPattern] -> AbsN [NamedArg DeBruijnPattern]
forall a. [ShortText] -> a -> AbsN a
AbsN (Telescope -> [ShortText]
teleNames Telescope
old_tel) ([NamedArg DeBruijnPattern] -> AbsN [NamedArg DeBruijnPattern])
-> [NamedArg DeBruijnPattern] -> AbsN [NamedArg DeBruijnPattern]
forall a b. (a -> b) -> a -> b
$ [NamedArg SplitPattern] -> [NamedArg DeBruijnPattern]
fromSplitPatterns ([NamedArg SplitPattern] -> [NamedArg DeBruijnPattern])
-> [NamedArg SplitPattern] -> [NamedArg DeBruijnPattern]
forall a b. (a -> b) -> a -> b
$ SplitClause -> [NamedArg SplitPattern]
scPats SplitClause
old_sc
    old_ps = AbsN [NamedArg DeBruijnPattern]
-> NamesT (TCMT IO) (AbsN [NamedArg DeBruijnPattern])
forall a. a -> NamesT (TCMT IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AbsN [NamedArg DeBruijnPattern]
 -> NamesT (TCMT IO) (AbsN [NamedArg DeBruijnPattern]))
-> AbsN [NamedArg DeBruijnPattern]
-> NamesT (TCMT IO) (AbsN [NamedArg DeBruijnPattern])
forall a b. (a -> b) -> a -> b
$ AbsN [NamedArg DeBruijnPattern]
old_ps'
    old_ty = AbsN (Dom Type) -> NamesT (TCMT IO) (AbsN (Dom Type))
forall a. a -> NamesT (TCMT IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AbsN (Dom Type) -> NamesT (TCMT IO) (AbsN (Dom Type)))
-> AbsN (Dom Type) -> NamesT (TCMT IO) (AbsN (Dom Type))
forall a b. (a -> b) -> a -> b
$ [ShortText] -> Dom Type -> AbsN (Dom Type)
forall a. [ShortText] -> a -> AbsN a
AbsN (Telescope -> [ShortText]
teleNames Telescope
old_tel) (Dom Type -> AbsN (Dom Type)) -> Dom Type -> AbsN (Dom Type)
forall a b. (a -> b) -> a -> b
$ Dom Type -> Maybe (Dom Type) -> Dom Type
forall a. a -> Maybe a -> a
fromMaybe Dom Type
forall a. HasCallStack => a
__IMPOSSIBLE__ (Maybe (Dom Type) -> Dom Type) -> Maybe (Dom Type) -> Dom Type
forall a b. (a -> b) -> a -> b
$ SplitClause -> Maybe (Dom Type)
scTarget SplitClause
old_sc
  -- old_tel = Γ(x: D η v)Δ
  -- Γ1, (x : D η v)  ⊢ delta = (δ : Δ)
    (gamma1x,delta') = splitTelescopeAt (size old_tel - blockingVarNo x) old_tel
    delta = AbsN Telescope -> NamesT (TCMT IO) (AbsN Telescope)
forall a. a -> NamesT (TCMT IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AbsN Telescope -> NamesT (TCMT IO) (AbsN Telescope))
-> AbsN Telescope -> NamesT (TCMT IO) (AbsN Telescope)
forall a b. (a -> b) -> a -> b
$ [ShortText] -> Telescope -> AbsN Telescope
forall a. [ShortText] -> a -> AbsN a
AbsN (Telescope -> [ShortText]
teleNames Telescope
gamma1x) (Telescope -> AbsN Telescope) -> Telescope -> AbsN Telescope
forall a b. (a -> b) -> a -> b
$ Telescope
delta'
    gamma1_size = (Telescope -> Int
forall a. Sized a => a -> Int
size Telescope
gamma1x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
    (gamma1,ExtendTel dType' _) = splitTelescopeAt gamma1_size gamma1x

  old_sides <- forM old_ps' $ \ [NamedArg DeBruijnPattern]
ps -> do
    let vs :: [Int]
vs = [NamedArg DeBruijnPattern] -> [Int]
forall p. IApplyVars p => p -> [Int]
iApplyVars [NamedArg DeBruijnPattern]
ps
    let tm :: Term
tm = QName -> [Elim] -> Term
Def QName
f ([Elim] -> Term) -> [Elim] -> Term
forall a b. (a -> b) -> a -> b
$ [NamedArg DeBruijnPattern] -> [Elim]
patternsToElims [NamedArg DeBruijnPattern]
ps
    xs <- [Int]
-> (Int -> TCMT IO (Term, (Term, Term)))
-> TCMT IO [(Term, (Term, Term))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Int]
vs ((Int -> TCMT IO (Term, (Term, Term)))
 -> TCMT IO [(Term, (Term, Term))])
-> (Int -> TCMT IO (Term, (Term, Term)))
-> TCMT IO [(Term, (Term, Term))]
forall a b. (a -> b) -> a -> b
$ \ Int
v ->
        -- have to reduce these under the appropriate substitutions, otherwise non-normalizing(?)
          ((Term, Term) -> (Term, (Term, Term)))
-> TCMT IO (Term, Term) -> TCMT IO (Term, (Term, Term))
forall a b. (a -> b) -> TCMT IO a -> TCMT IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Term
var Int
v,) (TCMT IO (Term, Term) -> TCMT IO (Term, (Term, Term)))
-> ((Term, Term) -> TCMT IO (Term, Term))
-> (Term, Term)
-> TCMT IO (Term, (Term, Term))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Term, Term) -> TCMT IO (Term, Term)
forall a (m :: * -> *). (Reduce a, MonadReduce m) => a -> m a
reduce ((Term, Term) -> TCMT IO (Term, (Term, Term)))
-> (Term, Term) -> TCMT IO (Term, (Term, Term))
forall a b. (a -> b) -> a -> b
$ (Int -> Term -> Substitution
forall a. EndoSubst a => Int -> a -> Substitution' a
inplaceS Int
v Term
iz Substitution' (SubstArg Term) -> Term -> Term
forall a. Subst a => Substitution' (SubstArg a) -> a -> a
`applySubst` Term
tm, Int -> Term -> Substitution
forall a. EndoSubst a => Int -> a -> Substitution' a
inplaceS Int
v Term
io Substitution' (SubstArg Term) -> Term -> Term
forall a. Subst a => Substitution' (SubstArg a) -> a -> a
`applySubst` Term
tm)
    return $ concatMap (\(Term
v,(Term
l,Term
r)) -> [(Term
tNeg Term -> Args -> Term
forall t. Apply t => t -> Args -> t
`apply` [Term -> Arg Term
forall e. e -> Arg e
argN Term
v],Term
l),(Term
v,Term
r)]) xs
  let
    gamma1ArgNames = Telescope -> [Arg ShortText]
teleArgNames Telescope
gamma1
    deltaArgNames = Telescope -> [Arg ShortText]
teleArgNames Telescope
delta'
  (params,xTel,dT) <- addContext gamma1 $ do
    Just (d, ps, _is) <- getDatatypeArgs . unDom =<< reduce dType'
    def <- getConstInfo d
    let dTy = Definition -> Type
defType Definition
def
    let Datatype{dataSort = s} = theDef def
    TelV tel _ <- telView dTy
    let params = [ShortText] -> Args -> AbsN Args
forall a. [ShortText] -> a -> AbsN a
AbsN (Telescope -> [ShortText]
teleNames Telescope
gamma1) Args
ps
        xTel = [ShortText] -> Telescope -> AbsN Telescope
forall a. [ShortText] -> a -> AbsN a
AbsN (Telescope -> [ShortText]
teleNames Telescope
gamma1) (Telescope
tel Telescope -> Args -> Telescope
forall t. Apply t => t -> Args -> t
`apply` Args
ps)

    dT <- runNamesT [] $ do
          s <- open $ AbsN (teleNames tel) s
          bindNArg (teleArgNames gamma1) $ \ ArgVars (TCMT IO)
g1 -> do
          [Arg ShortText]
-> (ArgVars (TCMT IO) -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) (AbsN Type)
forall (m :: * -> *) a.
Monad m =>
[Arg ShortText] -> (ArgVars m -> NamesT m a) -> NamesT m (AbsN a)
bindNArg (Telescope -> [Arg ShortText]
teleArgNames (Telescope -> [Arg ShortText]) -> Telescope -> [Arg ShortText]
forall a b. (a -> b) -> a -> b
$ AbsN Telescope -> Telescope
forall a. AbsN a -> a
unAbsN AbsN Telescope
xTel) ((ArgVars (TCMT IO) -> NamesT (TCMT IO) Type)
 -> NamesT (TCMT IO) (AbsN Type))
-> (ArgVars (TCMT IO) -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) (AbsN Type)
forall a b. (a -> b) -> a -> b
$ \ ArgVars (TCMT IO)
x -> do
          params <- AbsN Args -> NamesT (TCMT IO) (AbsN Args)
forall a. a -> NamesT (TCMT IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure AbsN Args
params NamesT (TCMT IO) (AbsN Args)
-> [NamesT (TCMT IO) (SubstArg Args)] -> NamesT (TCMT IO) Args
forall (m :: * -> *) a.
(Monad m, Subst a) =>
NamesT m (AbsN a) -> [NamesT m (SubstArg a)] -> NamesT m a
`applyN` ((Arg Term -> Term)
-> NamesT (TCMT IO) (Arg Term) -> NamesT (TCMT IO) Term
forall a b. (a -> b) -> NamesT (TCMT IO) a -> NamesT (TCMT IO) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Arg Term -> Term
forall e. Arg e -> e
unArg (NamesT (TCMT IO) (Arg Term) -> NamesT (TCMT IO) Term)
-> [NamesT (TCMT IO) (Arg Term)] -> [NamesT (TCMT IO) Term]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [NamesT (TCMT IO) (Arg Term)]
ArgVars (TCMT IO)
g1)
          x      <- sequence x
          s <- s `applyN` map (pure . unArg) (params ++ x)
          pure $ El s $ Def d [] `apply` (params ++ x)
    return $ (params, xTel,dT)

  let
    xTelI = AbsN Telescope -> NamesT (TCMT IO) (AbsN Telescope)
forall a. a -> NamesT (TCMT IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AbsN Telescope -> NamesT (TCMT IO) (AbsN Telescope))
-> AbsN Telescope -> NamesT (TCMT IO) (AbsN Telescope)
forall a b. (a -> b) -> a -> b
$ Type -> Telescope -> Telescope
expTelescope Type
interval (Telescope -> Telescope) -> AbsN Telescope -> AbsN Telescope
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AbsN Telescope
xTel
    xTelIArgNames = Telescope -> [Arg ShortText]
teleArgNames (AbsN Telescope -> Telescope
forall a. AbsN a -> a
unAbsN AbsN Telescope
xTel) -- same names

  -- Γ1, φ, p, ψ, q, x0 ⊢ pat := trX p φ (trX q ψ x0)
  let trX' = [Arg ShortText]
-> (ArgVars (TCMT IO)
    -> NamesT (TCMT IO) (AbsN (AbsN DeBruijnPattern)))
-> NamesT (TCMT IO) (AbsN (AbsN (AbsN DeBruijnPattern)))
forall (m :: * -> *) a.
Monad m =>
[Arg ShortText] -> (ArgVars m -> NamesT m a) -> NamesT m (AbsN a)
bindNArg [Arg ShortText]
gamma1ArgNames ((ArgVars (TCMT IO)
  -> NamesT (TCMT IO) (AbsN (AbsN DeBruijnPattern)))
 -> NamesT (TCMT IO) (AbsN (AbsN (AbsN DeBruijnPattern))))
-> (ArgVars (TCMT IO)
    -> NamesT (TCMT IO) (AbsN (AbsN DeBruijnPattern)))
-> NamesT (TCMT IO) (AbsN (AbsN (AbsN DeBruijnPattern)))
forall a b. (a -> b) -> a -> b
$ \ ArgVars (TCMT IO)
g1 -> do
             [Arg ShortText]
-> (ArgVars (TCMT IO) -> NamesT (TCMT IO) (AbsN DeBruijnPattern))
-> NamesT (TCMT IO) (AbsN (AbsN DeBruijnPattern))
forall (m :: * -> *) a.
Monad m =>
[Arg ShortText] -> (ArgVars m -> NamesT m a) -> NamesT m (AbsN a)
bindNArg ([ShortText -> Arg ShortText
forall e. e -> Arg e
defaultArg ShortText
"phi"] [Arg ShortText] -> [Arg ShortText] -> [Arg ShortText]
forall a. [a] -> [a] -> [a]
++ [Arg ShortText]
xTelIArgNames) ((ArgVars (TCMT IO) -> NamesT (TCMT IO) (AbsN DeBruijnPattern))
 -> NamesT (TCMT IO) (AbsN (AbsN DeBruijnPattern)))
-> (ArgVars (TCMT IO) -> NamesT (TCMT IO) (AbsN DeBruijnPattern))
-> NamesT (TCMT IO) (AbsN (AbsN DeBruijnPattern))
forall a b. (a -> b) -> a -> b
$ \ ArgVars (TCMT IO)
phi_p -> do
             [Arg ShortText]
-> (ArgVars (TCMT IO) -> NamesT (TCMT IO) DeBruijnPattern)
-> NamesT (TCMT IO) (AbsN DeBruijnPattern)
forall (m :: * -> *) a.
Monad m =>
[Arg ShortText] -> (ArgVars m -> NamesT m a) -> NamesT m (AbsN a)
bindNArg [ShortText -> Arg ShortText
forall e. e -> Arg e
defaultArg ShortText
"x0"] ((ArgVars (TCMT IO) -> NamesT (TCMT IO) DeBruijnPattern)
 -> NamesT (TCMT IO) (AbsN DeBruijnPattern))
-> (ArgVars (TCMT IO) -> NamesT (TCMT IO) DeBruijnPattern)
-> NamesT (TCMT IO) (AbsN DeBruijnPattern)
forall a b. (a -> b) -> a -> b
$ \ ArgVars (TCMT IO)
x0 -> do
             param_args <- (Args -> [NamedArg DeBruijnPattern])
-> NamesT (TCMT IO) Args
-> NamesT (TCMT IO) [NamedArg DeBruijnPattern]
forall a b. (a -> b) -> NamesT (TCMT IO) a -> NamesT (TCMT IO) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Arg Term -> NamedArg DeBruijnPattern)
-> Args -> [NamedArg DeBruijnPattern]
forall a b. (a -> b) -> [a] -> [b]
map (Hiding -> NamedArg DeBruijnPattern -> NamedArg DeBruijnPattern
forall a. LensHiding a => Hiding -> a -> a
setHiding Hiding
Hidden (NamedArg DeBruijnPattern -> NamedArg DeBruijnPattern)
-> (Arg Term -> NamedArg DeBruijnPattern)
-> Arg Term
-> NamedArg DeBruijnPattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Term -> Named_ DeBruijnPattern)
-> Arg Term -> NamedArg DeBruijnPattern
forall a b. (a -> b) -> Arg a -> Arg b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (DeBruijnPattern -> Named_ DeBruijnPattern
forall a name. a -> Named name a
unnamed (DeBruijnPattern -> Named_ DeBruijnPattern)
-> (Term -> DeBruijnPattern) -> Term -> Named_ DeBruijnPattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term -> DeBruijnPattern
forall a. Term -> Pattern' a
dotP))) (NamesT (TCMT IO) Args
 -> NamesT (TCMT IO) [NamedArg DeBruijnPattern])
-> NamesT (TCMT IO) Args
-> NamesT (TCMT IO) [NamedArg DeBruijnPattern]
forall a b. (a -> b) -> a -> b
$
               AbsN Args -> NamesT (TCMT IO) (AbsN Args)
forall a. a -> NamesT (TCMT IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure AbsN Args
params NamesT (TCMT IO) (AbsN Args)
-> [NamesT (TCMT IO) (SubstArg Args)] -> NamesT (TCMT IO) Args
forall (m :: * -> *) a.
(Monad m, Subst a) =>
NamesT m (AbsN a) -> [NamesT m (SubstArg a)] -> NamesT m a
`applyN` ((Arg Term -> Term)
-> NamesT (TCMT IO) (Arg Term) -> NamesT (TCMT IO) Term
forall a b. (a -> b) -> NamesT (TCMT IO) a -> NamesT (TCMT IO) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Arg Term -> Term
forall e. Arg e -> e
unArg (NamesT (TCMT IO) (Arg Term) -> NamesT (TCMT IO) Term)
-> [NamesT (TCMT IO) (Arg Term)] -> [NamesT (TCMT IO) Term]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [NamesT (TCMT IO) (Arg Term)]
ArgVars (TCMT IO)
g1)
             (phi, p) <- fromMaybe __IMPOSSIBLE__ . uncons <$> sequence phi_p
             x0 <- sequence x0
             pure $ DefP defaultPatternInfo q_trX $ param_args ++ p ++ [phi] ++ x0
      trX = ((AbsN (AbsN DeBruijnPattern) -> AbsN (AbsN Term))
-> AbsN (AbsN (AbsN DeBruijnPattern)) -> AbsN (AbsN (AbsN Term))
forall a b. (a -> b) -> AbsN a -> AbsN b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((AbsN (AbsN DeBruijnPattern) -> AbsN (AbsN Term))
 -> AbsN (AbsN (AbsN DeBruijnPattern)) -> AbsN (AbsN (AbsN Term)))
-> ((DeBruijnPattern -> Term)
    -> AbsN (AbsN DeBruijnPattern) -> AbsN (AbsN Term))
-> (DeBruijnPattern -> Term)
-> AbsN (AbsN (AbsN DeBruijnPattern))
-> AbsN (AbsN (AbsN Term))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AbsN DeBruijnPattern -> AbsN Term)
-> AbsN (AbsN DeBruijnPattern) -> AbsN (AbsN Term)
forall a b. (a -> b) -> AbsN a -> AbsN b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((AbsN DeBruijnPattern -> AbsN Term)
 -> AbsN (AbsN DeBruijnPattern) -> AbsN (AbsN Term))
-> ((DeBruijnPattern -> Term) -> AbsN DeBruijnPattern -> AbsN Term)
-> (DeBruijnPattern -> Term)
-> AbsN (AbsN DeBruijnPattern)
-> AbsN (AbsN Term)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DeBruijnPattern -> Term) -> AbsN DeBruijnPattern -> AbsN Term
forall a b. (a -> b) -> AbsN a -> AbsN b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) DeBruijnPattern -> Term
patternToTerm (AbsN (AbsN (AbsN DeBruijnPattern)) -> AbsN (AbsN (AbsN Term)))
-> NamesT (TCMT IO) (AbsN (AbsN (AbsN DeBruijnPattern)))
-> NamesT (TCMT IO) (AbsN (AbsN (AbsN Term)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamesT (TCMT IO) (AbsN (AbsN (AbsN DeBruijnPattern)))
trX'
  let
    hcompD' [NamesT (TCMT IO) Term]
g1 [NamesT (TCMT IO) Term]
v =
        [Arg ShortText]
-> (ArgVars (TCMT IO) -> NamesT (TCMT IO) DeBruijnPattern)
-> NamesT (TCMT IO) (AbsN DeBruijnPattern)
forall (m :: * -> *) a.
Monad m =>
[Arg ShortText] -> (ArgVars m -> NamesT m a) -> NamesT m (AbsN a)
bindNArg [ShortText -> Arg ShortText
forall e. e -> Arg e
argH ShortText
"psi",ShortText -> Arg ShortText
forall e. e -> Arg e
argN ShortText
"u", ShortText -> Arg ShortText
forall e. e -> Arg e
argN ShortText
"u0"] ((ArgVars (TCMT IO) -> NamesT (TCMT IO) DeBruijnPattern)
 -> NamesT (TCMT IO) (AbsN DeBruijnPattern))
-> (ArgVars (TCMT IO) -> NamesT (TCMT IO) DeBruijnPattern)
-> NamesT (TCMT IO) (AbsN DeBruijnPattern)
forall a b. (a -> b) -> a -> b
$ \ ArgVars (TCMT IO)
x0 -> do
        x0 <- [NamesT (TCMT IO) (NamedArg DeBruijnPattern)]
-> NamesT (TCMT IO) [NamedArg DeBruijnPattern]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence [NamesT (TCMT IO) (NamedArg DeBruijnPattern)]
ArgVars (TCMT IO)
x0
        LEl l t <- fromMaybe __IMPOSSIBLE__ <.> toLType =<< do pure dT `applyN` g1 `applyN` v
        let ty = (Term -> NamedArg DeBruijnPattern)
-> [Term] -> [NamedArg DeBruijnPattern]
forall a b. (a -> b) -> [a] -> [b]
map ((Term -> Named_ DeBruijnPattern)
-> Arg Term -> NamedArg DeBruijnPattern
forall a b. (a -> b) -> Arg a -> Arg b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (DeBruijnPattern -> Named_ DeBruijnPattern
forall a name. a -> Named name a
unnamed (DeBruijnPattern -> Named_ DeBruijnPattern)
-> (Term -> DeBruijnPattern) -> Term -> Named_ DeBruijnPattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term -> DeBruijnPattern
forall a. Term -> Pattern' a
dotP) (Arg Term -> NamedArg DeBruijnPattern)
-> (Term -> Arg Term) -> Term -> NamedArg DeBruijnPattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term -> Arg Term
forall e. e -> Arg e
argH) [Level -> Term
Level Level
l,Term
t]
        pure $ DefP defaultPatternInfo q_hcomp $ ty ++ x0
  hcompD <- runNamesT [] $
            bindN (map unArg $ gamma1ArgNames) $ \ Vars (TCMT IO)
g1 -> do
            [ShortText]
-> (Vars (TCMT IO) -> NamesT (TCMT IO) (AbsN Term))
-> NamesT (TCMT IO) (AbsN (AbsN Term))
forall (m :: * -> *) a.
Monad m =>
[ShortText] -> (Vars m -> NamesT m a) -> NamesT m (AbsN a)
bindN (Telescope -> [ShortText]
teleNames (Telescope -> [ShortText]) -> Telescope -> [ShortText]
forall a b. (a -> b) -> a -> b
$ AbsN Telescope -> Telescope
forall a. AbsN a -> a
unAbsN (AbsN Telescope -> Telescope) -> AbsN Telescope -> Telescope
forall a b. (a -> b) -> a -> b
$ AbsN Telescope
xTel) ((Vars (TCMT IO) -> NamesT (TCMT IO) (AbsN Term))
 -> NamesT (TCMT IO) (AbsN (AbsN Term)))
-> (Vars (TCMT IO) -> NamesT (TCMT IO) (AbsN Term))
-> NamesT (TCMT IO) (AbsN (AbsN Term))
forall a b. (a -> b) -> a -> b
$ \ Vars (TCMT IO)
v -> do
            (DeBruijnPattern -> Term) -> AbsN DeBruijnPattern -> AbsN Term
forall a b. (a -> b) -> AbsN a -> AbsN b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap DeBruijnPattern -> Term
patternToTerm (AbsN DeBruijnPattern -> AbsN Term)
-> NamesT (TCMT IO) (AbsN DeBruijnPattern)
-> NamesT (TCMT IO) (AbsN Term)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [NamesT (TCMT IO) Term]
-> [NamesT (TCMT IO) Term]
-> NamesT (TCMT IO) (AbsN DeBruijnPattern)
hcompD' [NamesT (TCMT IO) Term]
Vars (TCMT IO)
g1 [NamesT (TCMT IO) Term]
Vars (TCMT IO)
v
  let pat' =
            [ShortText]
-> (Vars (TCMT IO)
    -> NamesT (TCMT IO) (AbsN (AbsN DeBruijnPattern)))
-> NamesT (TCMT IO) (AbsN (AbsN (AbsN DeBruijnPattern)))
forall (m :: * -> *) a.
Monad m =>
[ShortText] -> (Vars m -> NamesT m a) -> NamesT m (AbsN a)
bindN ((Arg ShortText -> ShortText) -> [Arg ShortText] -> [ShortText]
forall a b. (a -> b) -> [a] -> [b]
map Arg ShortText -> ShortText
forall e. Arg e -> e
unArg [Arg ShortText]
gamma1ArgNames) ((Vars (TCMT IO) -> NamesT (TCMT IO) (AbsN (AbsN DeBruijnPattern)))
 -> NamesT (TCMT IO) (AbsN (AbsN (AbsN DeBruijnPattern))))
-> (Vars (TCMT IO)
    -> NamesT (TCMT IO) (AbsN (AbsN DeBruijnPattern)))
-> NamesT (TCMT IO) (AbsN (AbsN (AbsN DeBruijnPattern)))
forall a b. (a -> b) -> a -> b
$ \ Vars (TCMT IO)
g1 -> do
            List1 ShortText
-> (Vars1 (TCMT IO) -> NamesT (TCMT IO) (AbsN DeBruijnPattern))
-> NamesT (TCMT IO) (AbsN (AbsN DeBruijnPattern))
forall (m :: * -> *) a.
Monad m =>
List1 ShortText -> (Vars1 m -> NamesT m a) -> NamesT m (AbsN a)
bindN1 ((Arg ShortText -> ShortText)
-> NonEmpty (Arg ShortText) -> List1 ShortText
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Arg ShortText -> ShortText
forall e. Arg e -> e
unArg (ShortText -> Arg ShortText
forall e. e -> Arg e
defaultArg ShortText
"phi" Arg ShortText -> [Arg ShortText] -> NonEmpty (Arg ShortText)
forall a. a -> [a] -> NonEmpty a
:| [Arg ShortText]
xTelIArgNames)) ((Vars1 (TCMT IO) -> NamesT (TCMT IO) (AbsN DeBruijnPattern))
 -> NamesT (TCMT IO) (AbsN (AbsN DeBruijnPattern)))
-> (Vars1 (TCMT IO) -> NamesT (TCMT IO) (AbsN DeBruijnPattern))
-> NamesT (TCMT IO) (AbsN (AbsN DeBruijnPattern))
forall a b. (a -> b) -> a -> b
$ \ Vars1 (TCMT IO)
phi_p -> do
            [ShortText]
-> (Vars (TCMT IO) -> NamesT (TCMT IO) DeBruijnPattern)
-> NamesT (TCMT IO) (AbsN DeBruijnPattern)
forall (m :: * -> *) a.
Monad m =>
[ShortText] -> (Vars m -> NamesT m a) -> NamesT m (AbsN a)
bindN [ShortText
"psi",ShortText
"u",ShortText
"u0"] ((Vars (TCMT IO) -> NamesT (TCMT IO) DeBruijnPattern)
 -> NamesT (TCMT IO) (AbsN DeBruijnPattern))
-> (Vars (TCMT IO) -> NamesT (TCMT IO) DeBruijnPattern)
-> NamesT (TCMT IO) (AbsN DeBruijnPattern)
forall a b. (a -> b) -> a -> b
$ \ Vars (TCMT IO)
x0 -> do
            let trX :: NamesT (TCMT IO) (AbsN (AbsN DeBruijnPattern))
trX = NamesT (TCMT IO) (AbsN (AbsN (AbsN DeBruijnPattern)))
trX' NamesT (TCMT IO) (AbsN (AbsN (AbsN DeBruijnPattern)))
-> [NamesT (TCMT IO) (SubstArg (AbsN (AbsN DeBruijnPattern)))]
-> NamesT (TCMT IO) (AbsN (AbsN DeBruijnPattern))
forall (m :: * -> *) a.
(Monad m, Subst a) =>
NamesT m (AbsN a) -> [NamesT m (SubstArg a)] -> NamesT m a
`applyN` [NamesT (TCMT IO) DeBruijnPattern]
[NamesT (TCMT IO) (SubstArg (AbsN (AbsN DeBruijnPattern)))]
Vars (TCMT IO)
g1
            let p0 :: [NamesT (TCMT IO) Term]
p0 = NonEmpty (NamesT (TCMT IO) Term) -> [NamesT (TCMT IO) Term]
forall a. NonEmpty a -> [a]
List1.tail NonEmpty (NamesT (TCMT IO) Term)
Vars1 (TCMT IO)
phi_p [NamesT (TCMT IO) Term]
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> [NamesT (TCMT IO) Term]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \ NamesT (TCMT IO) Term
p -> NamesT (TCMT IO) Term
p NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> Term -> NamesT (TCMT IO) Term
forall a. a -> NamesT (TCMT IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
iz
            NamesT (TCMT IO) (AbsN (AbsN DeBruijnPattern))
trX NamesT (TCMT IO) (AbsN (AbsN DeBruijnPattern))
-> [NamesT (TCMT IO) (SubstArg (AbsN DeBruijnPattern))]
-> NamesT (TCMT IO) (AbsN DeBruijnPattern)
forall (m :: * -> *) a.
(Monad m, Subst a) =>
NamesT m (AbsN a) -> [NamesT m (SubstArg a)] -> NamesT m a
`applyN` (List1 (NamesT (TCMT IO) DeBruijnPattern)
-> [Item (List1 (NamesT (TCMT IO) DeBruijnPattern))]
forall l. IsList l => l -> [Item l]
List1.toList List1 (NamesT (TCMT IO) DeBruijnPattern)
Vars1 (TCMT IO)
phi_p) NamesT (TCMT IO) (AbsN DeBruijnPattern)
-> [NamesT (TCMT IO) (SubstArg DeBruijnPattern)]
-> NamesT (TCMT IO) DeBruijnPattern
forall (m :: * -> *) a.
(Monad m, Subst a) =>
NamesT m (AbsN a) -> [NamesT m (SubstArg a)] -> NamesT m a
`applyN` [[NamesT (TCMT IO) Term]
-> [NamesT (TCMT IO) Term]
-> NamesT (TCMT IO) (AbsN DeBruijnPattern)
hcompD' [NamesT (TCMT IO) Term]
Vars (TCMT IO)
g1 [NamesT (TCMT IO) Term]
p0 NamesT (TCMT IO) (AbsN DeBruijnPattern)
-> [NamesT (TCMT IO) (SubstArg DeBruijnPattern)]
-> NamesT (TCMT IO) DeBruijnPattern
forall (m :: * -> *) a.
(Monad m, Subst a) =>
NamesT m (AbsN a) -> [NamesT m (SubstArg a)] -> NamesT m a
`applyN` [NamesT (TCMT IO) DeBruijnPattern]
[NamesT (TCMT IO) (SubstArg DeBruijnPattern)]
Vars (TCMT IO)
x0]
      pat = ((AbsN (AbsN DeBruijnPattern) -> AbsN (AbsN Term))
-> AbsN (AbsN (AbsN DeBruijnPattern)) -> AbsN (AbsN (AbsN Term))
forall a b. (a -> b) -> AbsN a -> AbsN b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((AbsN (AbsN DeBruijnPattern) -> AbsN (AbsN Term))
 -> AbsN (AbsN (AbsN DeBruijnPattern)) -> AbsN (AbsN (AbsN Term)))
-> ((DeBruijnPattern -> Term)
    -> AbsN (AbsN DeBruijnPattern) -> AbsN (AbsN Term))
-> (DeBruijnPattern -> Term)
-> AbsN (AbsN (AbsN DeBruijnPattern))
-> AbsN (AbsN (AbsN Term))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AbsN DeBruijnPattern -> AbsN Term)
-> AbsN (AbsN DeBruijnPattern) -> AbsN (AbsN Term)
forall a b. (a -> b) -> AbsN a -> AbsN b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((AbsN DeBruijnPattern -> AbsN Term)
 -> AbsN (AbsN DeBruijnPattern) -> AbsN (AbsN Term))
-> ((DeBruijnPattern -> Term) -> AbsN DeBruijnPattern -> AbsN Term)
-> (DeBruijnPattern -> Term)
-> AbsN (AbsN DeBruijnPattern)
-> AbsN (AbsN Term)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DeBruijnPattern -> Term) -> AbsN DeBruijnPattern -> AbsN Term
forall a b. (a -> b) -> AbsN a -> AbsN b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) DeBruijnPattern -> Term
patternToTerm (AbsN (AbsN (AbsN DeBruijnPattern)) -> AbsN (AbsN (AbsN Term)))
-> NamesT (TCMT IO) (AbsN (AbsN (AbsN DeBruijnPattern)))
-> NamesT (TCMT IO) (AbsN (AbsN (AbsN Term)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamesT (TCMT IO) (AbsN (AbsN (AbsN DeBruijnPattern)))
pat'
  let deltaPat [NamesT (TCMT IO) Term]
g1 NamesT (TCMT IO) Term
phi [NamesT (TCMT IO) Term]
p [NamesT (TCMT IO) Term]
x0 =
        NamesT (TCMT IO) (AbsN Telescope)
delta NamesT (TCMT IO) (AbsN Telescope)
-> [NamesT (TCMT IO) (SubstArg Telescope)]
-> NamesT (TCMT IO) Telescope
forall (m :: * -> *) a.
(Monad m, Subst a) =>
NamesT m (AbsN a) -> [NamesT m (SubstArg a)] -> NamesT m a
`applyN` ([NamesT (TCMT IO) Term]
g1 [NamesT (TCMT IO) Term]
-> [NamesT (TCMT IO) Term] -> [NamesT (TCMT IO) Term]
forall a. [a] -> [a] -> [a]
++ [NamesT (TCMT IO) (AbsN (AbsN (AbsN Term)))
pat NamesT (TCMT IO) (AbsN (AbsN (AbsN Term)))
-> [NamesT (TCMT IO) (SubstArg (AbsN (AbsN Term)))]
-> NamesT (TCMT IO) (AbsN (AbsN Term))
forall (m :: * -> *) a.
(Monad m, Subst a) =>
NamesT m (AbsN a) -> [NamesT m (SubstArg a)] -> NamesT m a
`applyN` [NamesT (TCMT IO) Term]
[NamesT (TCMT IO) (SubstArg (AbsN (AbsN Term)))]
g1 NamesT (TCMT IO) (AbsN (AbsN Term))
-> [NamesT (TCMT IO) (SubstArg (AbsN Term))]
-> NamesT (TCMT IO) (AbsN Term)
forall (m :: * -> *) a.
(Monad m, Subst a) =>
NamesT m (AbsN a) -> [NamesT m (SubstArg a)] -> NamesT m a
`applyN` (NamesT (TCMT IO) Term
phiNamesT (TCMT IO) Term
-> [NamesT (TCMT IO) Term] -> [NamesT (TCMT IO) Term]
forall a. a -> [a] -> [a]
:[NamesT (TCMT IO) Term]
p) NamesT (TCMT IO) (AbsN Term)
-> [NamesT (TCMT IO) (SubstArg Term)] -> NamesT (TCMT IO) Term
forall (m :: * -> *) a.
(Monad m, Subst a) =>
NamesT m (AbsN a) -> [NamesT m (SubstArg a)] -> NamesT m a
`applyN` [NamesT (TCMT IO) Term]
[NamesT (TCMT IO) (SubstArg Term)]
x0])
  -- Ξ
  cTel <- runNamesT [] $
    abstractN (pure gamma1) $ \ Vars (TCMT IO)
g1 -> do
    ShortText
-> NamesT (TCMT IO) Type
-> (Var (TCMT IO) -> NamesT (TCMT IO) Telescope)
-> NamesT (TCMT IO) Telescope
forall (m :: * -> *) a.
(Monad m, Abstract a) =>
ShortText -> NamesT m Type -> (Var m -> NamesT m a) -> NamesT m a
abstractT ShortText
"φ" (Type -> NamesT (TCMT IO) Type
forall a. a -> NamesT (TCMT IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Type
interval) ((Var (TCMT IO) -> NamesT (TCMT IO) Telescope)
 -> NamesT (TCMT IO) Telescope)
-> (Var (TCMT IO) -> NamesT (TCMT IO) Telescope)
-> NamesT (TCMT IO) Telescope
forall a b. (a -> b) -> a -> b
$ \ Var (TCMT IO)
phi -> do
    NamesT (TCMT IO) Telescope
-> (Vars (TCMT IO) -> NamesT (TCMT IO) Telescope)
-> NamesT (TCMT IO) Telescope
forall (m :: * -> *) a.
(Monad m, Abstract a) =>
NamesT m Telescope -> (Vars m -> NamesT m a) -> NamesT m a
abstractN (NamesT (TCMT IO) (AbsN Telescope)
xTelI NamesT (TCMT IO) (AbsN Telescope)
-> [NamesT (TCMT IO) (SubstArg Telescope)]
-> NamesT (TCMT IO) Telescope
forall (m :: * -> *) a.
(Monad m, Subst a) =>
NamesT m (AbsN a) -> [NamesT m (SubstArg a)] -> NamesT m a
`applyN` [NamesT (TCMT IO) Term]
[NamesT (TCMT IO) (SubstArg Telescope)]
Vars (TCMT IO)
g1) ((Vars (TCMT IO) -> NamesT (TCMT IO) Telescope)
 -> NamesT (TCMT IO) Telescope)
-> (Vars (TCMT IO) -> NamesT (TCMT IO) Telescope)
-> NamesT (TCMT IO) Telescope
forall a b. (a -> b) -> a -> b
$ \ Vars (TCMT IO)
p -> do
    let p0 :: [NamesT (TCMT IO) Term]
p0 = [NamesT (TCMT IO) Term]
Vars (TCMT IO)
p [NamesT (TCMT IO) Term]
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> [NamesT (TCMT IO) Term]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \ NamesT (TCMT IO) Term
p -> NamesT (TCMT IO) Term
p NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> Term -> NamesT (TCMT IO) Term
forall a. a -> NamesT (TCMT IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
iz
    let ty :: NamesT (TCMT IO) Type
ty = AbsN (AbsN Type) -> NamesT (TCMT IO) (AbsN (AbsN Type))
forall a. a -> NamesT (TCMT IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure AbsN (AbsN Type)
dT NamesT (TCMT IO) (AbsN (AbsN Type))
-> [NamesT (TCMT IO) (SubstArg (AbsN Type))]
-> NamesT (TCMT IO) (AbsN Type)
forall (m :: * -> *) a.
(Monad m, Subst a) =>
NamesT m (AbsN a) -> [NamesT m (SubstArg a)] -> NamesT m a
`applyN` [NamesT (TCMT IO) Term]
[NamesT (TCMT IO) (SubstArg (AbsN Type))]
Vars (TCMT IO)
g1 NamesT (TCMT IO) (AbsN Type)
-> [NamesT (TCMT IO) (SubstArg Type)] -> NamesT (TCMT IO) Type
forall (m :: * -> *) a.
(Monad m, Subst a) =>
NamesT m (AbsN a) -> [NamesT m (SubstArg a)] -> NamesT m a
`applyN` [NamesT (TCMT IO) Term]
[NamesT (TCMT IO) (SubstArg Type)]
p0
    ShortText
-> NamesT (TCMT IO) Type
-> (Var (TCMT IO) -> NamesT (TCMT IO) Telescope)
-> NamesT (TCMT IO) Telescope
forall (m :: * -> *) a.
(Monad m, Abstract a) =>
ShortText -> NamesT m Type -> (Var m -> NamesT m a) -> NamesT m a
abstractT ShortText
"ψ" (Type -> NamesT (TCMT IO) Type
forall a. a -> NamesT (TCMT IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Type
interval) ((Var (TCMT IO) -> NamesT (TCMT IO) Telescope)
 -> NamesT (TCMT IO) Telescope)
-> (Var (TCMT IO) -> NamesT (TCMT IO) Telescope)
-> NamesT (TCMT IO) Telescope
forall a b. (a -> b) -> a -> b
$ \ Var (TCMT IO)
psi -> do
    ShortText
-> NamesT (TCMT IO) Type
-> (Var (TCMT IO) -> NamesT (TCMT IO) Telescope)
-> NamesT (TCMT IO) Telescope
forall (m :: * -> *) a.
(Monad m, Abstract a) =>
ShortText -> NamesT m Type -> (Var m -> NamesT m a) -> NamesT m a
abstractT ShortText
"u" (Type -> NamesT (TCMT IO) Type
forall a. a -> NamesT (TCMT IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Type
interval NamesT (TCMT IO) Type
-> NamesT (TCMT IO) Type -> NamesT (TCMT IO) Type
forall (m :: * -> *). HasOptions m => m Type -> m Type -> m Type
--> ShortText
-> NamesT (TCMT IO) Term
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall (m :: * -> *).
(MonadAddContext m, HasBuiltins m, MonadDebug m) =>
ShortText
-> NamesT m Term
-> (NamesT m Term -> NamesT m Type)
-> NamesT m Type
pPi' ShortText
"o" NamesT (TCMT IO) Term
Var (TCMT IO)
psi (\ NamesT (TCMT IO) Term
_ -> NamesT (TCMT IO) Type
ty)) ((Var (TCMT IO) -> NamesT (TCMT IO) Telescope)
 -> NamesT (TCMT IO) Telescope)
-> (Var (TCMT IO) -> NamesT (TCMT IO) Telescope)
-> NamesT (TCMT IO) Telescope
forall a b. (a -> b) -> a -> b
$ \ Var (TCMT IO)
u -> do
    ShortText
-> NamesT (TCMT IO) Type
-> (Var (TCMT IO) -> NamesT (TCMT IO) Telescope)
-> NamesT (TCMT IO) Telescope
forall (m :: * -> *) a.
(Monad m, Abstract a) =>
ShortText -> NamesT m Type -> (Var m -> NamesT m a) -> NamesT m a
abstractT ShortText
"u0" NamesT (TCMT IO) Type
ty ((Var (TCMT IO) -> NamesT (TCMT IO) Telescope)
 -> NamesT (TCMT IO) Telescope)
-> (Var (TCMT IO) -> NamesT (TCMT IO) Telescope)
-> NamesT (TCMT IO) Telescope
forall a b. (a -> b) -> a -> b
$ \ Var (TCMT IO)
u0 -> do
    [NamesT (TCMT IO) Term]
-> NamesT (TCMT IO) Term
-> [NamesT (TCMT IO) Term]
-> [NamesT (TCMT IO) Term]
-> NamesT (TCMT IO) Telescope
deltaPat [NamesT (TCMT IO) Term]
Vars (TCMT IO)
g1 NamesT (TCMT IO) Term
Var (TCMT IO)
phi [NamesT (TCMT IO) Term]
Vars (TCMT IO)
p [NamesT (TCMT IO) Term
Var (TCMT IO)
psi,NamesT (TCMT IO) Term
Var (TCMT IO)
u,NamesT (TCMT IO) Term
Var (TCMT IO)
u0]

  ps_ty_rhs <- runNamesT [] $ do
    bindN (map unArg gamma1ArgNames) $ \ Vars (TCMT IO)
g1 -> do
    ShortText
-> (Var (TCMT IO)
    -> NamesT
         (TCMT IO)
         (AbsN
            (Abs
               (Abs (Abs (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term)))))))
-> NamesT
     (TCMT IO)
     (Abs
        (AbsN
           (Abs
              (Abs (Abs (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term)))))))
forall (m :: * -> *) a.
Monad m =>
ShortText
-> ((forall b. (Subst b, DeBruijn b) => NamesT m b) -> NamesT m a)
-> NamesT m (Abs a)
bind ShortText
"φ" ((Var (TCMT IO)
  -> NamesT
       (TCMT IO)
       (AbsN
          (Abs
             (Abs (Abs (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term)))))))
 -> NamesT
      (TCMT IO)
      (Abs
         (AbsN
            (Abs
               (Abs (Abs (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term))))))))
-> (Var (TCMT IO)
    -> NamesT
         (TCMT IO)
         (AbsN
            (Abs
               (Abs (Abs (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term)))))))
-> NamesT
     (TCMT IO)
     (Abs
        (AbsN
           (Abs
              (Abs (Abs (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term)))))))
forall a b. (a -> b) -> a -> b
$ \ Var (TCMT IO)
phi -> do
    [ShortText]
-> (Vars (TCMT IO)
    -> NamesT
         (TCMT IO)
         (Abs
            (Abs (Abs (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term))))))
-> NamesT
     (TCMT IO)
     (AbsN
        (Abs
           (Abs (Abs (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term))))))
forall (m :: * -> *) a.
Monad m =>
[ShortText] -> (Vars m -> NamesT m a) -> NamesT m (AbsN a)
bindN ((Arg ShortText -> ShortText) -> [Arg ShortText] -> [ShortText]
forall a b. (a -> b) -> [a] -> [b]
map Arg ShortText -> ShortText
forall e. Arg e -> e
unArg [Arg ShortText]
xTelIArgNames) ((Vars (TCMT IO)
  -> NamesT
       (TCMT IO)
       (Abs
          (Abs (Abs (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term))))))
 -> NamesT
      (TCMT IO)
      (AbsN
         (Abs
            (Abs (Abs (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term)))))))
-> (Vars (TCMT IO)
    -> NamesT
         (TCMT IO)
         (Abs
            (Abs (Abs (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term))))))
-> NamesT
     (TCMT IO)
     (AbsN
        (Abs
           (Abs (Abs (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term))))))
forall a b. (a -> b) -> a -> b
$ \ Vars (TCMT IO)
p -> do
    ShortText
-> (Var (TCMT IO)
    -> NamesT
         (TCMT IO)
         (Abs (Abs (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term)))))
-> NamesT
     (TCMT IO)
     (Abs
        (Abs (Abs (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term)))))
forall (m :: * -> *) a.
Monad m =>
ShortText
-> ((forall b. (Subst b, DeBruijn b) => NamesT m b) -> NamesT m a)
-> NamesT m (Abs a)
bind ShortText
"ψ" ((Var (TCMT IO)
  -> NamesT
       (TCMT IO)
       (Abs (Abs (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term)))))
 -> NamesT
      (TCMT IO)
      (Abs
         (Abs (Abs (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term))))))
-> (Var (TCMT IO)
    -> NamesT
         (TCMT IO)
         (Abs (Abs (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term)))))
-> NamesT
     (TCMT IO)
     (Abs
        (Abs (Abs (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term)))))
forall a b. (a -> b) -> a -> b
$ \ Var (TCMT IO)
psi -> do
    ShortText
-> (Var (TCMT IO)
    -> NamesT
         (TCMT IO)
         (Abs (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term))))
-> NamesT
     (TCMT IO)
     (Abs (Abs (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term))))
forall (m :: * -> *) a.
Monad m =>
ShortText
-> ((forall b. (Subst b, DeBruijn b) => NamesT m b) -> NamesT m a)
-> NamesT m (Abs a)
bind ShortText
"u" ((Var (TCMT IO)
  -> NamesT
       (TCMT IO)
       (Abs (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term))))
 -> NamesT
      (TCMT IO)
      (Abs (Abs (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term)))))
-> (Var (TCMT IO)
    -> NamesT
         (TCMT IO)
         (Abs (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term))))
-> NamesT
     (TCMT IO)
     (Abs (Abs (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term))))
forall a b. (a -> b) -> a -> b
$ \ Var (TCMT IO)
u -> do
    ShortText
-> (Var (TCMT IO)
    -> NamesT
         (TCMT IO) (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term)))
-> NamesT
     (TCMT IO) (Abs (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term)))
forall (m :: * -> *) a.
Monad m =>
ShortText
-> ((forall b. (Subst b, DeBruijn b) => NamesT m b) -> NamesT m a)
-> NamesT m (Abs a)
bind ShortText
"u0" ((Var (TCMT IO)
  -> NamesT
       (TCMT IO) (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term)))
 -> NamesT
      (TCMT IO)
      (Abs (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term))))
-> (Var (TCMT IO)
    -> NamesT
         (TCMT IO) (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term)))
-> NamesT
     (TCMT IO) (Abs (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term)))
forall a b. (a -> b) -> a -> b
$ \ Var (TCMT IO)
u0 -> do
    [ShortText]
-> (Vars (TCMT IO)
    -> NamesT (TCMT IO) ([NamedArg DeBruijnPattern], Dom Type, Term))
-> NamesT
     (TCMT IO) (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term))
forall (m :: * -> *) a.
Monad m =>
[ShortText] -> (Vars m -> NamesT m a) -> NamesT m (AbsN a)
bindN ((Arg ShortText -> ShortText) -> [Arg ShortText] -> [ShortText]
forall a b. (a -> b) -> [a] -> [b]
map Arg ShortText -> ShortText
forall e. Arg e -> e
unArg [Arg ShortText]
deltaArgNames) ((Vars (TCMT IO)
  -> NamesT (TCMT IO) ([NamedArg DeBruijnPattern], Dom Type, Term))
 -> NamesT
      (TCMT IO) (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term)))
-> (Vars (TCMT IO)
    -> NamesT (TCMT IO) ([NamedArg DeBruijnPattern], Dom Type, Term))
-> NamesT
     (TCMT IO) (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term))
forall a b. (a -> b) -> a -> b
$ \ Vars (TCMT IO)
d -> do
    let
      x0 :: Vars TCM
      x0 :: Vars (TCMT IO)
x0 = [NamesT (TCMT IO) b
Var (TCMT IO)
psi,NamesT (TCMT IO) b
Var (TCMT IO)
u,NamesT (TCMT IO) b
Var (TCMT IO)
u0]
      ps :: NamesT TCM NAPs
      ps :: NamesT (TCMT IO) [NamedArg DeBruijnPattern]
ps = NamesT (TCMT IO) (AbsN [NamedArg DeBruijnPattern])
old_ps NamesT (TCMT IO) (AbsN [NamedArg DeBruijnPattern])
-> [NamesT (TCMT IO) (SubstArg [NamedArg DeBruijnPattern])]
-> NamesT (TCMT IO) [NamedArg DeBruijnPattern]
forall (m :: * -> *) a.
(Monad m, Subst a) =>
NamesT m (AbsN a) -> [NamesT m (SubstArg a)] -> NamesT m a
`applyN` ([NamesT (TCMT IO) DeBruijnPattern]
Vars (TCMT IO)
g1
                          [NamesT (TCMT IO) DeBruijnPattern]
-> [NamesT (TCMT IO) DeBruijnPattern]
-> [NamesT (TCMT IO) DeBruijnPattern]
forall a. [a] -> [a] -> [a]
++ [NamesT (TCMT IO) (AbsN (AbsN (AbsN DeBruijnPattern)))
pat' NamesT (TCMT IO) (AbsN (AbsN (AbsN DeBruijnPattern)))
-> [NamesT (TCMT IO) (SubstArg (AbsN (AbsN DeBruijnPattern)))]
-> NamesT (TCMT IO) (AbsN (AbsN DeBruijnPattern))
forall (m :: * -> *) a.
(Monad m, Subst a) =>
NamesT m (AbsN a) -> [NamesT m (SubstArg a)] -> NamesT m a
`applyN` [NamesT (TCMT IO) DeBruijnPattern]
[NamesT (TCMT IO) (SubstArg (AbsN (AbsN DeBruijnPattern)))]
Vars (TCMT IO)
g1 NamesT (TCMT IO) (AbsN (AbsN DeBruijnPattern))
-> [NamesT (TCMT IO) (SubstArg (AbsN DeBruijnPattern))]
-> NamesT (TCMT IO) (AbsN DeBruijnPattern)
forall (m :: * -> *) a.
(Monad m, Subst a) =>
NamesT m (AbsN a) -> [NamesT m (SubstArg a)] -> NamesT m a
`applyN` (NamesT (TCMT IO) DeBruijnPattern
Var (TCMT IO)
phiNamesT (TCMT IO) DeBruijnPattern
-> [NamesT (TCMT IO) DeBruijnPattern]
-> [NamesT (TCMT IO) DeBruijnPattern]
forall a. a -> [a] -> [a]
:[NamesT (TCMT IO) DeBruijnPattern]
Vars (TCMT IO)
p) NamesT (TCMT IO) (AbsN DeBruijnPattern)
-> [NamesT (TCMT IO) (SubstArg DeBruijnPattern)]
-> NamesT (TCMT IO) DeBruijnPattern
forall (m :: * -> *) a.
(Monad m, Subst a) =>
NamesT m (AbsN a) -> [NamesT m (SubstArg a)] -> NamesT m a
`applyN` [NamesT (TCMT IO) DeBruijnPattern]
[NamesT (TCMT IO) (SubstArg DeBruijnPattern)]
Vars (TCMT IO)
x0]
                          [NamesT (TCMT IO) DeBruijnPattern]
-> [NamesT (TCMT IO) DeBruijnPattern]
-> [NamesT (TCMT IO) DeBruijnPattern]
forall a. [a] -> [a] -> [a]
++ [NamesT (TCMT IO) DeBruijnPattern]
Vars (TCMT IO)
d)

      rhsTy :: NamesT (TCMT IO) (Dom Type)
rhsTy = NamesT (TCMT IO) (AbsN (Dom Type))
old_ty NamesT (TCMT IO) (AbsN (Dom Type))
-> [NamesT (TCMT IO) (SubstArg (Dom Type))]
-> NamesT (TCMT IO) (Dom Type)
forall (m :: * -> *) a.
(Monad m, Subst a) =>
NamesT m (AbsN a) -> [NamesT m (SubstArg a)] -> NamesT m a
`applyN` ([NamesT (TCMT IO) Term]
Vars (TCMT IO)
g1
                          [NamesT (TCMT IO) Term]
-> [NamesT (TCMT IO) Term] -> [NamesT (TCMT IO) Term]
forall a. [a] -> [a] -> [a]
++ [NamesT (TCMT IO) (AbsN (AbsN (AbsN Term)))
pat NamesT (TCMT IO) (AbsN (AbsN (AbsN Term)))
-> [NamesT (TCMT IO) (SubstArg (AbsN (AbsN Term)))]
-> NamesT (TCMT IO) (AbsN (AbsN Term))
forall (m :: * -> *) a.
(Monad m, Subst a) =>
NamesT m (AbsN a) -> [NamesT m (SubstArg a)] -> NamesT m a
`applyN` [NamesT (TCMT IO) Term]
[NamesT (TCMT IO) (SubstArg (AbsN (AbsN Term)))]
Vars (TCMT IO)
g1 NamesT (TCMT IO) (AbsN (AbsN Term))
-> [NamesT (TCMT IO) (SubstArg (AbsN Term))]
-> NamesT (TCMT IO) (AbsN Term)
forall (m :: * -> *) a.
(Monad m, Subst a) =>
NamesT m (AbsN a) -> [NamesT m (SubstArg a)] -> NamesT m a
`applyN` (NamesT (TCMT IO) Term
Var (TCMT IO)
phiNamesT (TCMT IO) Term
-> [NamesT (TCMT IO) Term] -> [NamesT (TCMT IO) Term]
forall a. a -> [a] -> [a]
:[NamesT (TCMT IO) Term]
Vars (TCMT IO)
p) NamesT (TCMT IO) (AbsN Term)
-> [NamesT (TCMT IO) (SubstArg Term)] -> NamesT (TCMT IO) Term
forall (m :: * -> *) a.
(Monad m, Subst a) =>
NamesT m (AbsN a) -> [NamesT m (SubstArg a)] -> NamesT m a
`applyN` [NamesT (TCMT IO) Term]
[NamesT (TCMT IO) (SubstArg Term)]
Vars (TCMT IO)
x0]
                          [NamesT (TCMT IO) Term]
-> [NamesT (TCMT IO) Term] -> [NamesT (TCMT IO) Term]
forall a. [a] -> [a] -> [a]
++ [NamesT (TCMT IO) Term]
Vars (TCMT IO)
d)

    xTel <- (Telescope -> NamesT (TCMT IO) (NamesT (TCMT IO) Telescope)
forall (m :: * -> *) a.
(Monad m, Subst a) =>
a -> NamesT m (NamesT m a)
open (Telescope -> NamesT (TCMT IO) (NamesT (TCMT IO) Telescope))
-> NamesT (TCMT IO) Telescope
-> NamesT (TCMT IO) (NamesT (TCMT IO) Telescope)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (NamesT (TCMT IO) Telescope
 -> NamesT (TCMT IO) (NamesT (TCMT IO) Telescope))
-> NamesT (TCMT IO) Telescope
-> NamesT (TCMT IO) (NamesT (TCMT IO) Telescope)
forall a b. (a -> b) -> a -> b
$ AbsN Telescope -> NamesT (TCMT IO) (AbsN Telescope)
forall a. a -> NamesT (TCMT IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure AbsN Telescope
xTel NamesT (TCMT IO) (AbsN Telescope)
-> [NamesT (TCMT IO) (SubstArg Telescope)]
-> NamesT (TCMT IO) Telescope
forall (m :: * -> *) a.
(Monad m, Subst a) =>
NamesT m (AbsN a) -> [NamesT m (SubstArg a)] -> NamesT m a
`applyN` [NamesT (TCMT IO) Term]
[NamesT (TCMT IO) (SubstArg Telescope)]
Vars (TCMT IO)
g1

    -- Ξ ⊢ pat-rec[i] := trX .. (hfill ... (~ i))
    pat_rec <- (open =<<) $ bind "i" $ \ Var (TCMT IO)
i -> do
      let
        tr :: NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
tr NamesT (TCMT IO) Term
x = NamesT (TCMT IO) (AbsN (AbsN (AbsN Term)))
trX NamesT (TCMT IO) (AbsN (AbsN (AbsN Term)))
-> [NamesT (TCMT IO) (SubstArg (AbsN (AbsN Term)))]
-> NamesT (TCMT IO) (AbsN (AbsN Term))
forall (m :: * -> *) a.
(Monad m, Subst a) =>
NamesT m (AbsN a) -> [NamesT m (SubstArg a)] -> NamesT m a
`applyN` [NamesT (TCMT IO) Term]
[NamesT (TCMT IO) (SubstArg (AbsN (AbsN Term)))]
Vars (TCMT IO)
g1 NamesT (TCMT IO) (AbsN (AbsN Term))
-> [NamesT (TCMT IO) (SubstArg (AbsN Term))]
-> NamesT (TCMT IO) (AbsN Term)
forall (m :: * -> *) a.
(Monad m, Subst a) =>
NamesT m (AbsN a) -> [NamesT m (SubstArg a)] -> NamesT m a
`applyN` (NamesT (TCMT IO) Term
Var (TCMT IO)
phiNamesT (TCMT IO) Term
-> [NamesT (TCMT IO) Term] -> [NamesT (TCMT IO) Term]
forall a. a -> [a] -> [a]
:[NamesT (TCMT IO) Term]
Vars (TCMT IO)
p) NamesT (TCMT IO) (AbsN Term)
-> [NamesT (TCMT IO) (SubstArg Term)] -> NamesT (TCMT IO) Term
forall (m :: * -> *) a.
(Monad m, Subst a) =>
NamesT m (AbsN a) -> [NamesT m (SubstArg a)] -> NamesT m a
`applyN` [NamesT (TCMT IO) Term
NamesT (TCMT IO) (SubstArg Term)
x]
        p0 :: [NamesT (TCMT IO) Term]
p0 = [NamesT (TCMT IO) Term]
Vars (TCMT IO)
p [NamesT (TCMT IO) Term]
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> [NamesT (TCMT IO) Term]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \ NamesT (TCMT IO) Term
p -> NamesT (TCMT IO) Term
p NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> Term -> NamesT (TCMT IO) Term
forall a. a -> NamesT (TCMT IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
iz
        rhs :: NamesT (TCMT IO) (Either Type Term)
rhs = NamesT (TCMT IO) Type
-> [(NamesT (TCMT IO) Term, NamesT (TCMT IO) Term)]
-> NamesT (TCMT IO) Term
-> NamesT (TCMT IO) (Either Type Term)
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadReduce m) =>
NamesT m Type
-> [(NamesT m Term, NamesT m Term)]
-> NamesT m Term
-> NamesT m (Either Type Term)
hcomp (AbsN (AbsN Type) -> NamesT (TCMT IO) (AbsN (AbsN Type))
forall a. a -> NamesT (TCMT IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure AbsN (AbsN Type)
dT NamesT (TCMT IO) (AbsN (AbsN Type))
-> [NamesT (TCMT IO) (SubstArg (AbsN Type))]
-> NamesT (TCMT IO) (AbsN Type)
forall (m :: * -> *) a.
(Monad m, Subst a) =>
NamesT m (AbsN a) -> [NamesT m (SubstArg a)] -> NamesT m a
`applyN` [NamesT (TCMT IO) Term]
[NamesT (TCMT IO) (SubstArg (AbsN Type))]
Vars (TCMT IO)
g1 NamesT (TCMT IO) (AbsN Type)
-> [NamesT (TCMT IO) (SubstArg Type)] -> NamesT (TCMT IO) Type
forall (m :: * -> *) a.
(Monad m, Subst a) =>
NamesT m (AbsN a) -> [NamesT m (SubstArg a)] -> NamesT m a
`applyN` [NamesT (TCMT IO) Term]
[NamesT (TCMT IO) (SubstArg Type)]
p0)
          [ (NamesT (TCMT IO) Term
Var (TCMT IO)
psi, ShortText
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall (m :: * -> *).
Monad m =>
ShortText -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
lam ShortText
"j" ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
 -> NamesT (TCMT IO) Term)
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall a b. (a -> b) -> a -> b
$ \ NamesT (TCMT IO) Term
j -> NamesT (TCMT IO) Term
Var (TCMT IO)
u NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> (NamesT (TCMT IO) Term
-> 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
j (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
neg NamesT (TCMT IO) Term
Var (TCMT IO)
i)))
          , (NamesT (TCMT IO) Term
Var (TCMT IO)
i  , ShortText
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall (m :: * -> *).
Monad m =>
ShortText -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
lam ShortText
"j" ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
 -> NamesT (TCMT IO) Term)
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall a b. (a -> b) -> a -> b
$ \ NamesT (TCMT IO) Term
_ -> ShortText
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall (m :: * -> *).
Monad m =>
ShortText -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
lam ShortText
"o" ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
 -> NamesT (TCMT IO) Term)
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall a b. (a -> b) -> a -> b
$ \ NamesT (TCMT IO) Term
_ -> NamesT (TCMT IO) Term
Var (TCMT IO)
u0)
          ]
          NamesT (TCMT IO) Term
Var (TCMT IO)
u0
      NamesT (TCMT IO) (Either Type Term)
rhs NamesT (TCMT IO) (Either Type Term)
-> (Either Type Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall a b.
NamesT (TCMT IO) a
-> (a -> NamesT (TCMT IO) b) -> NamesT (TCMT IO) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Left Type
ty -> VerboseKey -> NamesT (TCMT IO) Term
forall (m :: * -> *) a.
(HasCallStack, MonadDebug m) =>
VerboseKey -> m a
__IMPOSSIBLE_VERBOSE__ (VerboseKey -> NamesT (TCMT IO) Term)
-> VerboseKey -> NamesT (TCMT IO) Term
forall a b. (a -> b) -> a -> b
$ VerboseKey
"failed to create hcomp at instance of matched type " VerboseKey -> VerboseKey -> VerboseKey
forall a. [a] -> [a] -> [a]
++ Type -> VerboseKey
forall a. Pretty a => a -> VerboseKey
prettyShow Type
ty
        Right Term
bd -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
tr (Term -> NamesT (TCMT IO) Term
forall a. a -> NamesT (TCMT IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
bd)

    --   args : (i.old_tel)  -> ...
    let mkBndry NamesT (TCMT IO) (Abs [Term])
args = do
            args1 <- ((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
$ (Abs [Term] -> Term -> [Term]
Abs [Term] -> SubstArg [Term] -> [Term]
forall a. Subst a => Abs a -> SubstArg a -> a
absApp (Abs [Term] -> Term -> [Term])
-> NamesT (TCMT IO) (Abs [Term])
-> NamesT (TCMT IO) (Term -> [Term])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamesT (TCMT IO) (Abs [Term])
args NamesT (TCMT IO) (Term -> [Term])
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) [Term]
forall a b.
NamesT (TCMT IO) (a -> b)
-> NamesT (TCMT IO) a -> NamesT (TCMT IO) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Term -> NamesT (TCMT IO) Term
forall a. a -> NamesT (TCMT IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
io)
            -- faces ought to be constant on "j"
            faces <- pure (fmap (map fst) old_sides) `applyN` args1
            us <- forM (mapM (map snd) old_sides) $ \ AbsN Term
u -> do
                  ShortText
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall (m :: * -> *).
Monad m =>
ShortText -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
lam ShortText
"j" ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
 -> NamesT (TCMT IO) Term)
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall a b. (a -> b) -> a -> b
$ \ NamesT (TCMT IO) Term
j -> ShortText
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall (m :: * -> *).
Monad m =>
ShortText -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
lam ShortText
"o" ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
 -> NamesT (TCMT IO) Term)
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall a b. (a -> b) -> a -> b
$ \ NamesT (TCMT IO) Term
_ -> do
                    args <- ((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
$ (Abs [Term] -> Term -> [Term]
Abs [Term] -> SubstArg [Term] -> [Term]
forall a. Subst a => Abs a -> SubstArg a -> a
absApp (Abs [Term] -> Term -> [Term])
-> NamesT (TCMT IO) (Abs [Term])
-> NamesT (TCMT IO) (Term -> [Term])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamesT (TCMT IO) (Abs [Term])
args NamesT (TCMT IO) (Term -> [Term])
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) [Term]
forall a b.
NamesT (TCMT IO) (a -> b)
-> NamesT (TCMT IO) a -> NamesT (TCMT IO) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> NamesT (TCMT IO) Term
j)
                    pure u `applyN` args
            forM (zip faces us) $ \ (Term
phi,Term
u) -> (NamesT (TCMT IO) Term
 -> NamesT (TCMT IO) Term
 -> (NamesT (TCMT IO) Term, NamesT (TCMT IO) Term))
-> NamesT (TCMT IO) (NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) (NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) (NamesT (TCMT IO) Term, NamesT (TCMT IO) Term)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (,) (Term -> NamesT (TCMT IO) (NamesT (TCMT IO) Term)
forall (m :: * -> *) a.
(Monad m, Subst a) =>
a -> NamesT m (NamesT m a)
open Term
phi) (Term -> NamesT (TCMT IO) (NamesT (TCMT IO) Term)
forall (m :: * -> *) a.
(Monad m, Subst a) =>
a -> NamesT m (NamesT m a)
open Term
u)
    rhs <- do
      d_f <- (open =<<) $ bind "j" $ \ Var (TCMT IO)
j -> do
        tel <- ShortText
-> (Var (TCMT IO) -> NamesT (TCMT IO) Telescope)
-> NamesT (TCMT IO) (Abs Telescope)
forall (m :: * -> *) a.
Monad m =>
ShortText
-> ((forall b. (Subst b, DeBruijn b) => NamesT m b) -> NamesT m a)
-> NamesT m (Abs a)
bind ShortText
"j" ((Var (TCMT IO) -> NamesT (TCMT IO) Telescope)
 -> NamesT (TCMT IO) (Abs Telescope))
-> (Var (TCMT IO) -> NamesT (TCMT IO) Telescope)
-> NamesT (TCMT IO) (Abs Telescope)
forall a b. (a -> b) -> a -> b
$ \ Var (TCMT IO)
j -> NamesT (TCMT IO) (AbsN Telescope)
delta NamesT (TCMT IO) (AbsN Telescope)
-> [NamesT (TCMT IO) (SubstArg Telescope)]
-> NamesT (TCMT IO) Telescope
forall (m :: * -> *) a.
(Monad m, Subst a) =>
NamesT m (AbsN a) -> [NamesT m (SubstArg a)] -> NamesT m a
`applyN` ([NamesT (TCMT IO) Term]
Vars (TCMT IO)
g1 [NamesT (TCMT IO) Term]
-> [NamesT (TCMT IO) Term] -> [NamesT (TCMT IO) Term]
forall a. [a] -> [a] -> [a]
++ [Abs Term -> Term -> Term
Abs Term -> SubstArg Term -> Term
forall a. Subst a => Abs a -> SubstArg a -> a
absApp (Abs Term -> Term -> Term)
-> NamesT (TCMT IO) (Abs Term) -> NamesT (TCMT IO) (Term -> Term)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamesT (TCMT IO) (Abs Term)
pat_rec NamesT (TCMT IO) (Term -> Term)
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall a b.
NamesT (TCMT IO) (a -> b)
-> NamesT (TCMT IO) a -> NamesT (TCMT IO) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> NamesT (TCMT IO) Term
Var (TCMT IO)
j])
        let face = Term
iz
        j <- j
        d <- map defaultArg <$> sequence d
        lift $ covFillTele f tel face d j
      let args = ShortText
-> (Var (TCMT IO) -> NamesT (TCMT IO) [Term])
-> NamesT (TCMT IO) (Abs [Term])
forall (m :: * -> *) a.
Monad m =>
ShortText
-> ((forall b. (Subst b, DeBruijn b) => NamesT m b) -> NamesT m a)
-> NamesT m (Abs a)
bind ShortText
"j" ((Var (TCMT IO) -> NamesT (TCMT IO) [Term])
 -> NamesT (TCMT IO) (Abs [Term]))
-> (Var (TCMT IO) -> NamesT (TCMT IO) [Term])
-> NamesT (TCMT IO) (Abs [Term])
forall a b. (a -> b) -> a -> b
$ \ Var (TCMT IO)
j -> do
            g1 <- [NamesT (TCMT IO) Term] -> NamesT (TCMT IO) [Term]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence [NamesT (TCMT IO) Term]
Vars (TCMT IO)
g1
            x <- absApp <$> pat_rec <*> neg j
            ys <- absApp <$> d_f <*> neg j
            pure $ g1 ++ x:ys
      ty <- (open =<<) $ bind "j" $ \ Var (TCMT IO)
j -> do
           args <- ((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
$ Abs [Term] -> Term -> [Term]
Abs [Term] -> SubstArg [Term] -> [Term]
forall a. Subst a => Abs a -> SubstArg a -> a
absApp (Abs [Term] -> Term -> [Term])
-> NamesT (TCMT IO) (Abs [Term])
-> NamesT (TCMT IO) (Term -> [Term])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamesT (TCMT IO) (Abs [Term])
args NamesT (TCMT IO) (Term -> [Term])
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) [Term]
forall a b.
NamesT (TCMT IO) (a -> b)
-> NamesT (TCMT IO) a -> NamesT (TCMT IO) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> NamesT (TCMT IO) Term
Var (TCMT IO)
j
           fmap unDom $ old_ty `applyN` args
      let face = Term -> NamesT (TCMT IO) Term
forall a. a -> NamesT (TCMT IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
iz
      othersys <- (open =<<) $ lam "j" $ \ NamesT (TCMT IO) Term
j -> ShortText
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall (m :: * -> *).
Monad m =>
ShortText -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
lam ShortText
"o" ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
 -> NamesT (TCMT IO) Term)
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall a b. (a -> b) -> a -> b
$ \ NamesT (TCMT IO) Term
_ -> do
        args' <- ((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
$ Abs [Term] -> Term -> [Term]
Abs [Term] -> SubstArg [Term] -> [Term]
forall a. Subst a => Abs a -> SubstArg a -> a
absApp (Abs [Term] -> Term -> [Term])
-> NamesT (TCMT IO) (Abs [Term])
-> NamesT (TCMT IO) (Term -> [Term])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamesT (TCMT IO) (Abs [Term])
args NamesT (TCMT IO) (Term -> [Term])
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) [Term]
forall a b.
NamesT (TCMT IO) (a -> b)
-> NamesT (TCMT IO) a -> NamesT (TCMT IO) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> NamesT (TCMT IO) Term
j
        fmap (Def f) $ (fmap patternsToElims <$> old_ps) `applyN` args'
      sys <- mkBndry args
      let
        -- we could specialize all of sysphi/syspsi/base to compute
        -- away trX or the hcomp respectively, should lead to
        -- smaller/more efficient terms.
        --
        -- we could also ditch sysphi completely,
        -- as the computation rule for hcomp would achieve the same.
        sysphi = NamesT (TCMT IO) Term
othersys
        syspsi = NamesT (TCMT IO) Term
othersys
      base <- (open =<<) $ do
        args' <- (mapM open =<<) $ absApp <$> args <*> pure iz
        fmap (Def f) $ (fmap patternsToElims <$> old_ps) `applyN` args'
      transpSys ty ((phi,sysphi):(psi,syspsi):sys) face base
    (,,) <$> ps <*> rhsTy <*> pure rhs
  let (ps,ty,rhs) = unAbsN $ unAbs $ unAbs $ unAbs $ unAbsN $ unAbs $ unAbsN $ ps_ty_rhs
  reportSDoc "tc.cover.trx.hcomp" 20 $ "trX-hcomp clause for" <+> prettyTCM f
  let c = Clause { clauseLHSRange :: Range
clauseLHSRange  = Range
forall a. Range' a
noRange
                 , clauseFullRange :: Range
clauseFullRange = Range
forall a. Range' a
noRange
                 , clauseTel :: Telescope
clauseTel       = Telescope
cTel
                 , namedClausePats :: [NamedArg DeBruijnPattern]
namedClausePats = [NamedArg DeBruijnPattern]
ps
                 , clauseBody :: Maybe Term
clauseBody      = Term -> Maybe Term
forall a. a -> Maybe a
Just Term
rhs
                 , clauseType :: Maybe (Arg Type)
clauseType      = Arg Type -> Maybe (Arg Type)
forall a. a -> Maybe a
Just (Arg Type -> Maybe (Arg Type)) -> Arg Type -> Maybe (Arg Type)
forall a b. (a -> b) -> a -> b
$ ArgInfo -> Type -> Arg Type
forall e. ArgInfo -> e -> Arg e
Arg (Dom Type -> ArgInfo
forall a. LensArgInfo a => a -> ArgInfo
getArgInfo Dom Type
ty) (Dom Type -> Type
forall t e. Dom' t e -> e
unDom Dom Type
ty)
                 , clauseCatchall :: Catchall
clauseCatchall    = Catchall
forall a. Null a => a
empty
                 , clauseRecursive :: ClauseRecursive
clauseRecursive   = ClauseRecursive
YesRecursive
                 , clauseUnreachable :: Maybe Bool
clauseUnreachable = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False
                 , clauseEllipsis :: ExpandedEllipsis
clauseEllipsis    = ExpandedEllipsis
NoEllipsis
                 , clauseWhereModule :: Maybe ModuleName
clauseWhereModule = Maybe ModuleName
forall a. Maybe a
Nothing
                 }
  debugClause "tc.cover.trx.hcomp" c
  return c

createMissingTrXConClause ::
     QName -- trX
  -> QName -- f defined
  -> Arg Nat
  -> BlockingVar
  -> SplitClause
  -> QName -- constructor name
  -> UnifyEquiv
  -> TCM Clause
createMissingTrXConClause :: QName
-> QName
-> Arg Int
-> BlockingVar
-> SplitClause
-> QName
-> UnifyEquiv
-> TCM Clause
createMissingTrXConClause QName
q_trX QName
f Arg Int
n BlockingVar
x SplitClause
old_sc QName
c (UE Telescope
gamma Telescope
gamma' Telescope
xTel [Term]
u [Term]
v PatternSubstitution
rho Substitution
tau Substitution
leftInv) = do
  VerboseKey -> Int -> TCMT IO Doc -> TCMT IO ()
forall (m :: * -> *).
MonadDebug m =>
VerboseKey -> Int -> TCMT IO Doc -> m ()
reportSDoc VerboseKey
"tc.cover.trxcon" Int
20 (TCMT IO Doc -> TCMT IO ()) -> TCMT IO Doc -> TCMT IO ()
forall a b. (a -> b) -> a -> b
$ TCMT IO Doc
"trX-con clause for" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> QName -> TCMT IO Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
forall (m :: * -> *). MonadPretty m => QName -> m Doc
prettyTCM QName
f TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> TCMT IO Doc
"with con" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> QName -> TCMT IO Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
forall (m :: * -> *). MonadPretty m => QName -> m Doc
prettyTCM QName
c
  VerboseKey -> Int -> TCMT IO Doc -> TCMT IO ()
forall (m :: * -> *).
MonadDebug m =>
VerboseKey -> Int -> TCMT IO Doc -> m ()
reportSDoc VerboseKey
"tc.cover.trxcon" Int
20 (TCMT IO Doc -> TCMT IO ()) -> TCMT IO Doc -> TCMT IO ()
forall a b. (a -> b) -> a -> b
$ Int -> TCMT IO Doc -> TCMT IO Doc
forall (m :: * -> *). Functor m => Int -> m Doc -> m Doc
nest Int
2 (TCMT IO Doc -> TCMT IO Doc) -> TCMT IO Doc -> TCMT IO Doc
forall a b. (a -> b) -> a -> b
$ [TCMT IO Doc] -> TCMT IO Doc
forall (m :: * -> *) (t :: * -> *).
(Applicative m, Foldable t) =>
t (m Doc) -> m Doc
vcat ([TCMT IO Doc] -> TCMT IO Doc) -> [TCMT IO Doc] -> TCMT IO Doc
forall a b. (a -> b) -> a -> b
$
    [ TCMT IO Doc
"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
    , 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'
    , TCMT IO Doc
"xTel" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> Telescope -> TCMT IO Doc -> TCMT IO Doc
forall b (m :: * -> *) a.
(AddContext b, MonadAddContext m) =>
b -> m a -> m a
forall (m :: * -> *) a.
MonadAddContext m =>
Telescope -> m a -> m a
addContext Telescope
gamma (Telescope -> TCMT IO Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
forall (m :: * -> *). MonadPretty m => Telescope -> m Doc
prettyTCM Telescope
xTel)
    , TCMT IO Doc
"u"  TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> Telescope -> TCMT IO Doc -> TCMT IO Doc
forall b (m :: * -> *) a.
(AddContext b, MonadAddContext m) =>
b -> m a -> m a
forall (m :: * -> *) a.
MonadAddContext m =>
Telescope -> m a -> m a
addContext Telescope
gamma ([Term] -> TCMT IO Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
forall (m :: * -> *). MonadPretty m => [Term] -> m Doc
prettyTCM [Term]
u)
    , TCMT IO Doc
"v"  TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> Telescope -> TCMT IO Doc -> TCMT IO Doc
forall b (m :: * -> *) a.
(AddContext b, MonadAddContext m) =>
b -> m a -> m a
forall (m :: * -> *) a.
MonadAddContext m =>
Telescope -> m a -> m a
addContext Telescope
gamma ([Term] -> TCMT IO Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
forall (m :: * -> *). MonadPretty m => [Term] -> m Doc
prettyTCM [Term]
v)
    , TCMT IO Doc
"rho" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> Telescope -> TCMT IO Doc -> TCMT IO Doc
forall b (m :: * -> *) a.
(AddContext b, MonadAddContext m) =>
b -> m a -> m a
forall (m :: * -> *) a.
MonadAddContext m =>
Telescope -> m a -> m a
addContext Telescope
gamma' (PatternSubstitution -> TCMT IO Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
forall (m :: * -> *). MonadPretty m => PatternSubstitution -> m Doc
prettyTCM PatternSubstitution
rho)
    , TCMT IO Doc
"tau" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> Substitution -> TCMT IO Doc
forall (m :: * -> *) a. (Applicative m, Pretty a) => a -> m Doc
pretty Substitution
tau
    ]

  Constructor{conSrcCon = chead} <- Definition -> Defn
theDef (Definition -> Defn) -> TCMT IO Definition -> TCMT IO Defn
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> QName -> TCMT IO Definition
forall (m :: * -> *).
(HasConstInfo m, HasCallStack) =>
QName -> m Definition
getConstInfo QName
c

  -- = TheInfo $ UE delta1' eqTel (map unArg conIxs) (map unArg givenIxs) rho0 tau leftInv

  -- η : Params_D ⊢ c : (a : Args(η)) → D η (ξ(η,a))

  -- scTel old_sc = Γ1, (x : D η v), Δ
  -- Γ1, (x : D η v), Δ ⊢ f old_ps : old_t [α(γ1,x,δ) ↦ e(γ1,x,δ)]

  -- Γ = Γ1, a : Args(η)
  -- Γ ⊢ u = ξ(η,a)
  -- Γ ⊢ c a : D η u

  -- Γ' ⊢ ρ : Γ

  -- Γ' ⊢ u[ρ] = v[ρ] : X(η)[ρ]

  -- Γ' ⊢ c a[ρ] : (D η v)[ρ]

  -- Γ' ⊢ ρx := ρ,x = c a[ρ] : Γ,(x : D η v)

  -- Γ',Δ[ρx] ⊢ old_t[ρx]
  -- Γ',Δ[ρx] ⊢ f old_ps[ρx] : old_t[ρx] [α[ρx] ↦ e[γ1,x,δ][ρx]]

  -- Γ,(φ : I),(p : Path X(η) u v) ⊢ τ : Γ'

  -- Γ,(φ : I),(p : Path X(η) u v) ⊢ [ρx][τ] = [ρ[τ], x = c a[ρ[τ]]] : Γ,(x : D η v)

  -- Γ,(φ : I),(p : Path X(η) u v) ⊢ leftInv : ρ[τ],i1,refl ≡ idS : Γ,(φ : I),(p : Path X(η) u v)

  -- Γ,(φ : I),(p : Path X(η) u v)| (i : I) ⊢ leftInv i : Γ,(φ : I),(p : Path X(η) u v)

  -- Γ,(φ : I),(p : Path X(η) u v) ⊢ leftInv i0 = ρ[τ],i1,refl : Γ,(φ : I),(p : Path X(η) u v)
  -- Γ,(φ : I),(p : Path X(η) u v) ⊢ leftInv i1 = γ   ,φ ,p    : Γ,(φ : I),(p : Path X(η) u v)
  --                                 leftInv[φ = i1][i] = idS

  -- Γ,(φ : I),(p : Path X(η) u v),Δ[ρx][τ] ⊢ τ' = liftS |Δ[ρx]| τ : Γ',Δ[ρx]

  -- Γ,(φ : I),(p : Path X(η) u v),Δ[ρx][τ] ⊢
  --            w := f old_ps[γ1[ρ[τ]],x = c a[ρ[τ]],δ] : old_t[ρx][τ'] = old_t[γ1[ρ[τ]],x = c a[ρ[τ]],δ]

  -- Γ,(φ : I),(p : Path X(η) u v),Δ[ρx][τ], α(γ1,x,δ)[ρx][τ'] ⊢ w = e(γ1,x,δ)[ρx][τ']

  -- Γ,(φ : I),(p : Path X(η) u v) ⊢ pat := trX p φ (c a) : D η v


  -- Ξ := Γ,(φ : I),(p : Path X(η) u v),(δ : Δ[x = pat])

  -- Ξ ⊢ δ_f[1] = trTel (i. Δ[γ1[leftInv (~ i)], pat[leftInv (~i)]]) φ δ : Δ[ρ[τ], x = c a[ρ[τ]]]

  -- Ξ ⊢ w[δ_f[1]] : old_t[γ1[ρ[τ]],x = c a[ρ[τ]],δ_f[1]]
  -- Ξ, α(γ1,x,δ)[ρx][τ'][δ = δ_f[1]] ⊢ w[δ_f[1]] = e(γ1,x,δ)[ρx][τ'][δ_f[1]]

  -- Ξ, α(γ1[ρ[τ]],c a[ρ[τ]],δ_f[1]) ⊢ w[δ_f[1]] = e(γ1[ρ[τ]],c a[ρ[τ]],δ_f[1])

  -- Recap:
  -- Γ1, (x : D η v), Δ ⊢ f old_ps : old_t [α(γ1,x,δ) ↦ e(γ1,x,δ)]
  -- Ξ := Γ,(φ : I),(p : Path X(η) u v),(δ : Δ[x = pat])
  -- Ξ ⊢ δ_f[1] := trTel (i. Δ[γ1[leftInv (~ i)], pat[leftInv (~i)]]) φ δ : Δ[ρ[τ], x = c a[ρ[τ]]]
  -- Γ,(φ : I),(p : Path X(η) u v),Δ[ρx][τ] ⊢
  --            w := f old_ps[γ1[ρ[τ]],x = c a[ρ[τ]],δ] : old_t[ρx][τ'] = old_t[γ1[ρ[τ]],x = c a[ρ[τ]],δ]
  -- Γ,(φ : I),(p : Path X(η) u v) ⊢ pat := trX p φ (c a) : D η v


  -- Ξ ⊢ ?rhs : old_t[γ1,x = pat,δ] [α(γ1,pat,δ) ↦ e(γ1,pat,δ)
  --                               ,φ           ↦ w
  --                               ]

  -- ?rhs := transp (i. old_t[γ1[leftInv i],x = pat[leftInv i], δ_f[~i]]) φ (w[δ_f[1]])

  -- we shall consider α(γ1,pat,δ) = α(γ1[ρ[τ]],c a[ρ[τ]],δ_f[1])
  -- also rather than (p : Path X(η) u v) we'll have (p : I -> X(η)), same as the type of trX.

  iz <- primIZero
  interval <- primIntervalType
  let
    old_tel = SplitClause -> Telescope
scTel SplitClause
old_sc
    old_ps = AbsN [NamedArg DeBruijnPattern]
-> NamesT (TCMT IO) (AbsN [NamedArg DeBruijnPattern])
forall a. a -> NamesT (TCMT IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AbsN [NamedArg DeBruijnPattern]
 -> NamesT (TCMT IO) (AbsN [NamedArg DeBruijnPattern]))
-> AbsN [NamedArg DeBruijnPattern]
-> NamesT (TCMT IO) (AbsN [NamedArg DeBruijnPattern])
forall a b. (a -> b) -> a -> b
$ [ShortText]
-> [NamedArg DeBruijnPattern] -> AbsN [NamedArg DeBruijnPattern]
forall a. [ShortText] -> a -> AbsN a
AbsN (Telescope -> [ShortText]
teleNames Telescope
old_tel) ([NamedArg DeBruijnPattern] -> AbsN [NamedArg DeBruijnPattern])
-> [NamedArg DeBruijnPattern] -> AbsN [NamedArg DeBruijnPattern]
forall a b. (a -> b) -> a -> b
$ [NamedArg SplitPattern] -> [NamedArg DeBruijnPattern]
fromSplitPatterns ([NamedArg SplitPattern] -> [NamedArg DeBruijnPattern])
-> [NamedArg SplitPattern] -> [NamedArg DeBruijnPattern]
forall a b. (a -> b) -> a -> b
$ SplitClause -> [NamedArg SplitPattern]
scPats SplitClause
old_sc
    old_ty = AbsN (Dom Type) -> NamesT (TCMT IO) (AbsN (Dom Type))
forall a. a -> NamesT (TCMT IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AbsN (Dom Type) -> NamesT (TCMT IO) (AbsN (Dom Type)))
-> AbsN (Dom Type) -> NamesT (TCMT IO) (AbsN (Dom Type))
forall a b. (a -> b) -> a -> b
$ [ShortText] -> Dom Type -> AbsN (Dom Type)
forall a. [ShortText] -> a -> AbsN a
AbsN (Telescope -> [ShortText]
teleNames Telescope
old_tel) (Dom Type -> AbsN (Dom Type)) -> Dom Type -> AbsN (Dom Type)
forall a b. (a -> b) -> a -> b
$ Dom Type -> Maybe (Dom Type) -> Dom Type
forall a. a -> Maybe a -> a
fromMaybe Dom Type
forall a. HasCallStack => a
__IMPOSSIBLE__ (Maybe (Dom Type) -> Dom Type) -> Maybe (Dom Type) -> Dom Type
forall a b. (a -> b) -> a -> b
$ SplitClause -> Maybe (Dom Type)
scTarget SplitClause
old_sc
  -- old_tel = Γ(x: D η v)Δ
  -- Γ1, (x : D η v)  ⊢ delta = (δ : Δ)
    (gamma1x,delta') = splitTelescopeAt (size old_tel - blockingVarNo x) old_tel

    gammaArgNames = Telescope -> [Arg ShortText]
teleArgNames Telescope
gamma
    deltaArgNames = Telescope -> [Arg ShortText]
teleArgNames Telescope
delta'

    xTelI = AbsN Telescope -> NamesT (TCMT IO) (AbsN Telescope)
forall a. a -> NamesT (TCMT IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AbsN Telescope -> NamesT (TCMT IO) (AbsN Telescope))
-> AbsN Telescope -> NamesT (TCMT IO) (AbsN Telescope)
forall a b. (a -> b) -> a -> b
$ [ShortText] -> Telescope -> AbsN Telescope
forall a. [ShortText] -> a -> AbsN a
AbsN (Telescope -> [ShortText]
teleNames Telescope
gamma) (Telescope -> AbsN Telescope) -> Telescope -> AbsN Telescope
forall a b. (a -> b) -> a -> b
$ Type -> Telescope -> Telescope
expTelescope Type
interval Telescope
xTel
    delta = AbsN Telescope -> NamesT (TCMT IO) (AbsN Telescope)
forall a. a -> NamesT (TCMT IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AbsN Telescope -> NamesT (TCMT IO) (AbsN Telescope))
-> AbsN Telescope -> NamesT (TCMT IO) (AbsN Telescope)
forall a b. (a -> b) -> a -> b
$ [ShortText] -> Telescope -> AbsN Telescope
forall a. [ShortText] -> a -> AbsN a
AbsN (Telescope -> [ShortText]
teleNames Telescope
gamma1x) (Telescope -> AbsN Telescope) -> Telescope -> AbsN Telescope
forall a b. (a -> b) -> a -> b
$ Telescope
delta'
    gamma1_size = (Telescope -> Int
forall a. Sized a => a -> Int
size Telescope
gamma1x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
    (gamma1,ExtendTel dType' _) = splitTelescopeAt gamma1_size gamma1x

  params <- addContext gamma1 $ do
    Just (_d, ps, _is) <- getDatatypeArgs . unDom =<< reduce dType'
    return $ AbsN (teleNames gamma1) ps
  -- Γ, φ , p ⊢ pat := trX p φ (c a)
  let pat' =
            [Arg ShortText]
-> (ArgVars (TCMT IO) -> NamesT (TCMT IO) (AbsN DeBruijnPattern))
-> NamesT (TCMT IO) (AbsN (AbsN DeBruijnPattern))
forall (m :: * -> *) a.
Monad m =>
[Arg ShortText] -> (ArgVars m -> NamesT m a) -> NamesT m (AbsN a)
bindNArg [Arg ShortText]
gammaArgNames ((ArgVars (TCMT IO) -> NamesT (TCMT IO) (AbsN DeBruijnPattern))
 -> NamesT (TCMT IO) (AbsN (AbsN DeBruijnPattern)))
-> (ArgVars (TCMT IO) -> NamesT (TCMT IO) (AbsN DeBruijnPattern))
-> NamesT (TCMT IO) (AbsN (AbsN DeBruijnPattern))
forall a b. (a -> b) -> a -> b
$ \ ArgVars (TCMT IO)
g1_args -> do
            [Arg ShortText]
-> (ArgVars (TCMT IO) -> NamesT (TCMT IO) DeBruijnPattern)
-> NamesT (TCMT IO) (AbsN DeBruijnPattern)
forall (m :: * -> *) a.
Monad m =>
[Arg ShortText] -> (ArgVars m -> NamesT m a) -> NamesT m (AbsN a)
bindNArg ([ShortText -> Arg ShortText
forall e. e -> Arg e
defaultArg ShortText
"phi"] [Arg ShortText] -> [Arg ShortText] -> [Arg ShortText]
forall a. [a] -> [a] -> [a]
++ Telescope -> [Arg ShortText]
teleArgNames Telescope
xTel) ((ArgVars (TCMT IO) -> NamesT (TCMT IO) DeBruijnPattern)
 -> NamesT (TCMT IO) (AbsN DeBruijnPattern))
-> (ArgVars (TCMT IO) -> NamesT (TCMT IO) DeBruijnPattern)
-> NamesT (TCMT IO) (AbsN DeBruijnPattern)
forall a b. (a -> b) -> a -> b
$ \ ArgVars (TCMT IO)
phi_p -> do
            let ([NamesT (TCMT IO) (NamedArg DeBruijnPattern)]
g1,[NamesT (TCMT IO) (NamedArg DeBruijnPattern)]
args) = Int
-> [NamesT (TCMT IO) (NamedArg DeBruijnPattern)]
-> ([NamesT (TCMT IO) (NamedArg DeBruijnPattern)],
    [NamesT (TCMT IO) (NamedArg DeBruijnPattern)])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
gamma1_size [NamesT (TCMT IO) (NamedArg DeBruijnPattern)]
ArgVars (TCMT IO)
g1_args
            (phi, p) <- (NamedArg DeBruijnPattern, [NamedArg DeBruijnPattern])
-> Maybe (NamedArg DeBruijnPattern, [NamedArg DeBruijnPattern])
-> (NamedArg DeBruijnPattern, [NamedArg DeBruijnPattern])
forall a. a -> Maybe a -> a
fromMaybe (NamedArg DeBruijnPattern, [NamedArg DeBruijnPattern])
forall a. HasCallStack => a
__IMPOSSIBLE__ (Maybe (NamedArg DeBruijnPattern, [NamedArg DeBruijnPattern])
 -> (NamedArg DeBruijnPattern, [NamedArg DeBruijnPattern]))
-> ([NamedArg DeBruijnPattern]
    -> Maybe (NamedArg DeBruijnPattern, [NamedArg DeBruijnPattern]))
-> [NamedArg DeBruijnPattern]
-> (NamedArg DeBruijnPattern, [NamedArg DeBruijnPattern])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [NamedArg DeBruijnPattern]
-> Maybe (NamedArg DeBruijnPattern, [NamedArg DeBruijnPattern])
forall a. [a] -> Maybe (a, [a])
uncons ([NamedArg DeBruijnPattern]
 -> (NamedArg DeBruijnPattern, [NamedArg DeBruijnPattern]))
-> NamesT (TCMT IO) [NamedArg DeBruijnPattern]
-> NamesT
     (TCMT IO) (NamedArg DeBruijnPattern, [NamedArg DeBruijnPattern])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [NamesT (TCMT IO) (NamedArg DeBruijnPattern)]
-> NamesT (TCMT IO) [NamedArg DeBruijnPattern]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence [NamesT (TCMT IO) (NamedArg DeBruijnPattern)]
ArgVars (TCMT IO)
phi_p
            args <- sequence args
            let cargs = Named_ DeBruijnPattern -> NamedArg DeBruijnPattern
forall e. e -> Arg e
defaultArg (Named_ DeBruijnPattern -> NamedArg DeBruijnPattern)
-> Named_ DeBruijnPattern -> NamedArg DeBruijnPattern
forall a b. (a -> b) -> a -> b
$ DeBruijnPattern -> Named_ DeBruijnPattern
forall a name. a -> Named name a
unnamed (DeBruijnPattern -> Named_ DeBruijnPattern)
-> DeBruijnPattern -> Named_ DeBruijnPattern
forall a b. (a -> b) -> a -> b
$ ConHead
-> ConPatternInfo -> [NamedArg DeBruijnPattern] -> DeBruijnPattern
forall x.
ConHead -> ConPatternInfo -> [NamedArg (Pattern' x)] -> Pattern' x
ConP ConHead
chead ConPatternInfo
noConPatternInfo [NamedArg DeBruijnPattern]
args
            param_args <- fmap (map (setHiding Hidden . fmap (unnamed . dotP))) $
              pure params `applyN` take gamma1_size (fmap unArg <$> g1_args)
            pure $ DefP defaultPatternInfo q_trX $ param_args ++ p ++ [phi,cargs]
      pat = ((AbsN DeBruijnPattern -> AbsN Term)
-> AbsN (AbsN DeBruijnPattern) -> AbsN (AbsN Term)
forall a b. (a -> b) -> AbsN a -> AbsN b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((AbsN DeBruijnPattern -> AbsN Term)
 -> AbsN (AbsN DeBruijnPattern) -> AbsN (AbsN Term))
-> ((DeBruijnPattern -> Term) -> AbsN DeBruijnPattern -> AbsN Term)
-> (DeBruijnPattern -> Term)
-> AbsN (AbsN DeBruijnPattern)
-> AbsN (AbsN Term)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DeBruijnPattern -> Term) -> AbsN DeBruijnPattern -> AbsN Term
forall a b. (a -> b) -> AbsN a -> AbsN b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) DeBruijnPattern -> Term
patternToTerm (AbsN (AbsN DeBruijnPattern) -> AbsN (AbsN Term))
-> NamesT (TCMT IO) (AbsN (AbsN DeBruijnPattern))
-> NamesT (TCMT IO) (AbsN (AbsN Term))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamesT (TCMT IO) (AbsN (AbsN DeBruijnPattern))
pat'
      pat_left' = ((AbsN Term -> AbsN (Abs Term))
-> AbsN (AbsN Term) -> AbsN (AbsN (Abs Term))
forall a b. (a -> b) -> AbsN a -> AbsN b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((AbsN Term -> AbsN (Abs Term))
 -> AbsN (AbsN Term) -> AbsN (AbsN (Abs Term)))
-> ((Term -> Abs Term) -> AbsN Term -> AbsN (Abs Term))
-> (Term -> Abs Term)
-> AbsN (AbsN Term)
-> AbsN (AbsN (Abs Term))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Term -> Abs Term) -> AbsN Term -> AbsN (Abs Term)
forall a b. (a -> b) -> AbsN a -> AbsN b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) (ShortText -> Term -> Abs Term
forall a. ShortText -> a -> Abs a
Abs ShortText
"i" (Term -> Abs Term) -> (Term -> Term) -> Term -> Abs Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Substitution' (SubstArg Term) -> Term -> Term
forall a. Subst a => Substitution' (SubstArg a) -> a -> a
applySubst Substitution
Substitution' (SubstArg Term)
leftInv)) (AbsN (AbsN Term) -> AbsN (AbsN (Abs Term)))
-> NamesT (TCMT IO) (AbsN (AbsN Term))
-> NamesT (TCMT IO) (AbsN (AbsN (Abs Term)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamesT (TCMT IO) (AbsN (AbsN Term))
pat
      g1_left' = [ShortText]
-> (Vars (TCMT IO) -> NamesT (TCMT IO) (AbsN (Abs [Term])))
-> NamesT (TCMT IO) (AbsN (AbsN (Abs [Term])))
forall (m :: * -> *) a.
Monad m =>
[ShortText] -> (Vars m -> NamesT m a) -> NamesT m (AbsN a)
bindN ((Arg ShortText -> ShortText) -> [Arg ShortText] -> [ShortText]
forall a b. (a -> b) -> [a] -> [b]
map Arg ShortText -> ShortText
forall e. Arg e -> e
unArg [Arg ShortText]
gammaArgNames) ((Vars (TCMT IO) -> NamesT (TCMT IO) (AbsN (Abs [Term])))
 -> NamesT (TCMT IO) (AbsN (AbsN (Abs [Term]))))
-> (Vars (TCMT IO) -> NamesT (TCMT IO) (AbsN (Abs [Term])))
-> NamesT (TCMT IO) (AbsN (AbsN (Abs [Term])))
forall a b. (a -> b) -> a -> b
$ \ Vars (TCMT IO)
g1_args -> do
                [ShortText]
-> (Vars (TCMT IO) -> NamesT (TCMT IO) (Abs [Term]))
-> NamesT (TCMT IO) (AbsN (Abs [Term]))
forall (m :: * -> *) a.
Monad m =>
[ShortText] -> (Vars m -> NamesT m a) -> NamesT m (AbsN a)
bindN ((Arg ShortText -> ShortText) -> [Arg ShortText] -> [ShortText]
forall a b. (a -> b) -> [a] -> [b]
map Arg ShortText -> ShortText
forall e. Arg e -> e
unArg ([Arg ShortText] -> [ShortText]) -> [Arg ShortText] -> [ShortText]
forall a b. (a -> b) -> a -> b
$ [ShortText -> Arg ShortText
forall e. e -> Arg e
defaultArg ShortText
"phi"] [Arg ShortText] -> [Arg ShortText] -> [Arg ShortText]
forall a. [a] -> [a] -> [a]
++ Telescope -> [Arg ShortText]
teleArgNames Telescope
xTel) ((Vars (TCMT IO) -> NamesT (TCMT IO) (Abs [Term]))
 -> NamesT (TCMT IO) (AbsN (Abs [Term])))
-> (Vars (TCMT IO) -> NamesT (TCMT IO) (Abs [Term]))
-> NamesT (TCMT IO) (AbsN (Abs [Term]))
forall a b. (a -> b) -> a -> b
$ \ Vars (TCMT IO)
phi_p -> do
                g1 <- [NamesT (TCMT IO) Term] -> NamesT (TCMT IO) [Term]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence ([NamesT (TCMT IO) Term] -> NamesT (TCMT IO) [Term])
-> [NamesT (TCMT IO) Term] -> NamesT (TCMT IO) [Term]
forall a b. (a -> b) -> a -> b
$ Int -> [NamesT (TCMT IO) Term] -> [NamesT (TCMT IO) Term]
forall a. Int -> [a] -> [a]
take Int
gamma1_size [NamesT (TCMT IO) Term]
Vars (TCMT IO)
g1_args :: NamesT TCM [Term]
                pure $ Abs "i" (applySubst leftInv g1)

  gamma <- return $ pure gamma
  let deltaPat [NamesT (TCMT IO) Term]
g1_args NamesT (TCMT IO) Term
phi [NamesT (TCMT IO) Term]
p =
        NamesT (TCMT IO) (AbsN Telescope)
delta NamesT (TCMT IO) (AbsN Telescope)
-> [NamesT (TCMT IO) (SubstArg Telescope)]
-> NamesT (TCMT IO) Telescope
forall (m :: * -> *) a.
(Monad m, Subst a) =>
NamesT m (AbsN a) -> [NamesT m (SubstArg a)] -> NamesT m a
`applyN` (Int -> [NamesT (TCMT IO) Term] -> [NamesT (TCMT IO) Term]
forall a. Int -> [a] -> [a]
take Int
gamma1_size [NamesT (TCMT IO) Term]
g1_args [NamesT (TCMT IO) Term]
-> [NamesT (TCMT IO) Term] -> [NamesT (TCMT IO) Term]
forall a. [a] -> [a] -> [a]
++ [NamesT (TCMT IO) (AbsN (AbsN Term))
pat NamesT (TCMT IO) (AbsN (AbsN Term))
-> [NamesT (TCMT IO) (SubstArg (AbsN Term))]
-> NamesT (TCMT IO) (AbsN Term)
forall (m :: * -> *) a.
(Monad m, Subst a) =>
NamesT m (AbsN a) -> [NamesT m (SubstArg a)] -> NamesT m a
`applyN` [NamesT (TCMT IO) Term]
[NamesT (TCMT IO) (SubstArg (AbsN Term))]
g1_args NamesT (TCMT IO) (AbsN Term)
-> [NamesT (TCMT IO) (SubstArg Term)] -> NamesT (TCMT IO) Term
forall (m :: * -> *) a.
(Monad m, Subst a) =>
NamesT m (AbsN a) -> [NamesT m (SubstArg a)] -> NamesT m a
`applyN` (NamesT (TCMT IO) Term
phiNamesT (TCMT IO) Term
-> [NamesT (TCMT IO) Term] -> [NamesT (TCMT IO) Term]
forall a. a -> [a] -> [a]
:[NamesT (TCMT IO) Term]
p)])
  let neg NamesT m Term
i = m Term -> NamesT m Term
forall (m :: * -> *) a. Monad m => m a -> NamesT m a
cl m Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primINeg NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT m Term
i
  -- Ξ
  cTel <- runNamesT [] $
    abstractN gamma $ \ Vars (TCMT IO)
g1_args -> do
    ShortText
-> NamesT (TCMT IO) Type
-> (Var (TCMT IO) -> NamesT (TCMT IO) Telescope)
-> NamesT (TCMT IO) Telescope
forall (m :: * -> *) a.
(Monad m, Abstract a) =>
ShortText -> NamesT m Type -> (Var m -> NamesT m a) -> NamesT m a
abstractT ShortText
"φ" (Type -> NamesT (TCMT IO) Type
forall a. a -> NamesT (TCMT IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Type
interval) ((Var (TCMT IO) -> NamesT (TCMT IO) Telescope)
 -> NamesT (TCMT IO) Telescope)
-> (Var (TCMT IO) -> NamesT (TCMT IO) Telescope)
-> NamesT (TCMT IO) Telescope
forall a b. (a -> b) -> a -> b
$ \ Var (TCMT IO)
phi -> do
    NamesT (TCMT IO) Telescope
-> (Vars (TCMT IO) -> NamesT (TCMT IO) Telescope)
-> NamesT (TCMT IO) Telescope
forall (m :: * -> *) a.
(Monad m, Abstract a) =>
NamesT m Telescope -> (Vars m -> NamesT m a) -> NamesT m a
abstractN (NamesT (TCMT IO) (AbsN Telescope)
xTelI NamesT (TCMT IO) (AbsN Telescope)
-> [NamesT (TCMT IO) (SubstArg Telescope)]
-> NamesT (TCMT IO) Telescope
forall (m :: * -> *) a.
(Monad m, Subst a) =>
NamesT m (AbsN a) -> [NamesT m (SubstArg a)] -> NamesT m a
`applyN` [NamesT (TCMT IO) Term]
[NamesT (TCMT IO) (SubstArg Telescope)]
Vars (TCMT IO)
g1_args) ((Vars (TCMT IO) -> NamesT (TCMT IO) Telescope)
 -> NamesT (TCMT IO) Telescope)
-> (Vars (TCMT IO) -> NamesT (TCMT IO) Telescope)
-> NamesT (TCMT IO) Telescope
forall a b. (a -> b) -> a -> b
$ \ Vars (TCMT IO)
p -> do
    [NamesT (TCMT IO) Term]
-> NamesT (TCMT IO) Term
-> [NamesT (TCMT IO) Term]
-> NamesT (TCMT IO) Telescope
deltaPat [NamesT (TCMT IO) Term]
Vars (TCMT IO)
g1_args NamesT (TCMT IO) Term
Var (TCMT IO)
phi [NamesT (TCMT IO) Term]
Vars (TCMT IO)
p
  ps_ty_rhs <- runNamesT [] $ do
    bindN (map unArg gammaArgNames) $ \ Vars (TCMT IO)
g1_args -> do
    ShortText
-> (Var (TCMT IO)
    -> NamesT
         (TCMT IO)
         (AbsN (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term))))
-> NamesT
     (TCMT IO)
     (Abs (AbsN (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term))))
forall (m :: * -> *) a.
Monad m =>
ShortText
-> ((forall b. (Subst b, DeBruijn b) => NamesT m b) -> NamesT m a)
-> NamesT m (Abs a)
bind ShortText
"phi" ((Var (TCMT IO)
  -> NamesT
       (TCMT IO)
       (AbsN (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term))))
 -> NamesT
      (TCMT IO)
      (Abs (AbsN (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term)))))
-> (Var (TCMT IO)
    -> NamesT
         (TCMT IO)
         (AbsN (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term))))
-> NamesT
     (TCMT IO)
     (Abs (AbsN (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term))))
forall a b. (a -> b) -> a -> b
$ \ Var (TCMT IO)
phi -> do
    [ShortText]
-> (Vars (TCMT IO)
    -> NamesT
         (TCMT IO) (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term)))
-> NamesT
     (TCMT IO)
     (AbsN (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term)))
forall (m :: * -> *) a.
Monad m =>
[ShortText] -> (Vars m -> NamesT m a) -> NamesT m (AbsN a)
bindN (Telescope -> [ShortText]
teleNames Telescope
xTel) ((Vars (TCMT IO)
  -> NamesT
       (TCMT IO) (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term)))
 -> NamesT
      (TCMT IO)
      (AbsN (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term))))
-> (Vars (TCMT IO)
    -> NamesT
         (TCMT IO) (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term)))
-> NamesT
     (TCMT IO)
     (AbsN (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term)))
forall a b. (a -> b) -> a -> b
$ \ Vars (TCMT IO)
p -> do
    [ShortText]
-> (Vars (TCMT IO)
    -> NamesT (TCMT IO) ([NamedArg DeBruijnPattern], Dom Type, Term))
-> NamesT
     (TCMT IO) (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term))
forall (m :: * -> *) a.
Monad m =>
[ShortText] -> (Vars m -> NamesT m a) -> NamesT m (AbsN a)
bindN ((Arg ShortText -> ShortText) -> [Arg ShortText] -> [ShortText]
forall a b. (a -> b) -> [a] -> [b]
map Arg ShortText -> ShortText
forall e. Arg e -> e
unArg ([Arg ShortText] -> [ShortText]) -> [Arg ShortText] -> [ShortText]
forall a b. (a -> b) -> a -> b
$ [Arg ShortText]
deltaArgNames) ((Vars (TCMT IO)
  -> NamesT (TCMT IO) ([NamedArg DeBruijnPattern], Dom Type, Term))
 -> NamesT
      (TCMT IO) (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term)))
-> (Vars (TCMT IO)
    -> NamesT (TCMT IO) ([NamedArg DeBruijnPattern], Dom Type, Term))
-> NamesT
     (TCMT IO) (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term))
forall a b. (a -> b) -> a -> b
$ \ Vars (TCMT IO)
d -> do
    let
      g1_left :: NamesT (TCMT IO) (Abs [Term])
g1_left = NamesT (TCMT IO) (AbsN (AbsN (Abs [Term])))
g1_left' NamesT (TCMT IO) (AbsN (AbsN (Abs [Term])))
-> [NamesT (TCMT IO) (SubstArg (AbsN (Abs [Term])))]
-> NamesT (TCMT IO) (AbsN (Abs [Term]))
forall (m :: * -> *) a.
(Monad m, Subst a) =>
NamesT m (AbsN a) -> [NamesT m (SubstArg a)] -> NamesT m a
`applyN` [NamesT (TCMT IO) Term]
[NamesT (TCMT IO) (SubstArg (AbsN (Abs [Term])))]
Vars (TCMT IO)
g1_args NamesT (TCMT IO) (AbsN (Abs [Term]))
-> [NamesT (TCMT IO) (SubstArg (Abs [Term]))]
-> NamesT (TCMT IO) (Abs [Term])
forall (m :: * -> *) a.
(Monad m, Subst a) =>
NamesT m (AbsN a) -> [NamesT m (SubstArg a)] -> NamesT m a
`applyN` (NamesT (TCMT IO) Term
Var (TCMT IO)
phiNamesT (TCMT IO) Term
-> [NamesT (TCMT IO) Term] -> [NamesT (TCMT IO) Term]
forall a. a -> [a] -> [a]
:[NamesT (TCMT IO) Term]
Vars (TCMT IO)
p)
      pat_left :: NamesT (TCMT IO) (Abs Term)
pat_left = NamesT (TCMT IO) (AbsN (AbsN (Abs Term)))
pat_left' NamesT (TCMT IO) (AbsN (AbsN (Abs Term)))
-> [NamesT (TCMT IO) (SubstArg (AbsN (Abs Term)))]
-> NamesT (TCMT IO) (AbsN (Abs Term))
forall (m :: * -> *) a.
(Monad m, Subst a) =>
NamesT m (AbsN a) -> [NamesT m (SubstArg a)] -> NamesT m a
`applyN` [NamesT (TCMT IO) Term]
[NamesT (TCMT IO) (SubstArg (AbsN (Abs Term)))]
Vars (TCMT IO)
g1_args NamesT (TCMT IO) (AbsN (Abs Term))
-> [NamesT (TCMT IO) (SubstArg (Abs Term))]
-> NamesT (TCMT IO) (Abs Term)
forall (m :: * -> *) a.
(Monad m, Subst a) =>
NamesT m (AbsN a) -> [NamesT m (SubstArg a)] -> NamesT m a
`applyN` (NamesT (TCMT IO) Term
Var (TCMT IO)
phiNamesT (TCMT IO) Term
-> [NamesT (TCMT IO) Term] -> [NamesT (TCMT IO) Term]
forall a. a -> [a] -> [a]
:[NamesT (TCMT IO) Term]
Vars (TCMT IO)
p)
      g1 :: Vars TCM
      g1 :: Vars (TCMT IO)
g1 = Int -> [NamesT (TCMT IO) b] -> [NamesT (TCMT IO) b]
forall a. Int -> [a] -> [a]
take Int
gamma1_size [NamesT (TCMT IO) b]
Vars (TCMT IO)
g1_args

      args :: Vars TCM
      args :: Vars (TCMT IO)
args = Int -> [NamesT (TCMT IO) b] -> [NamesT (TCMT IO) b]
forall a. Int -> [a] -> [a]
drop Int
gamma1_size [NamesT (TCMT IO) b]
Vars (TCMT IO)
g1_args

      ps :: NamesT TCM NAPs
      ps :: NamesT (TCMT IO) [NamedArg DeBruijnPattern]
ps = NamesT (TCMT IO) (AbsN [NamedArg DeBruijnPattern])
old_ps NamesT (TCMT IO) (AbsN [NamedArg DeBruijnPattern])
-> [NamesT (TCMT IO) (SubstArg [NamedArg DeBruijnPattern])]
-> NamesT (TCMT IO) [NamedArg DeBruijnPattern]
forall (m :: * -> *) a.
(Monad m, Subst a) =>
NamesT m (AbsN a) -> [NamesT m (SubstArg a)] -> NamesT m a
`applyN` ([NamesT (TCMT IO) DeBruijnPattern]
Vars (TCMT IO)
g1 [NamesT (TCMT IO) DeBruijnPattern]
-> [NamesT (TCMT IO) DeBruijnPattern]
-> [NamesT (TCMT IO) DeBruijnPattern]
forall a. [a] -> [a] -> [a]
++ [NamesT (TCMT IO) (AbsN (AbsN DeBruijnPattern))
pat' NamesT (TCMT IO) (AbsN (AbsN DeBruijnPattern))
-> [NamesT (TCMT IO) (SubstArg (AbsN DeBruijnPattern))]
-> NamesT (TCMT IO) (AbsN DeBruijnPattern)
forall (m :: * -> *) a.
(Monad m, Subst a) =>
NamesT m (AbsN a) -> [NamesT m (SubstArg a)] -> NamesT m a
`applyN` [NamesT (TCMT IO) DeBruijnPattern]
[NamesT (TCMT IO) (SubstArg (AbsN DeBruijnPattern))]
Vars (TCMT IO)
g1_args NamesT (TCMT IO) (AbsN DeBruijnPattern)
-> [NamesT (TCMT IO) (SubstArg DeBruijnPattern)]
-> NamesT (TCMT IO) DeBruijnPattern
forall (m :: * -> *) a.
(Monad m, Subst a) =>
NamesT m (AbsN a) -> [NamesT m (SubstArg a)] -> NamesT m a
`applyN` (NamesT (TCMT IO) DeBruijnPattern
Var (TCMT IO)
phiNamesT (TCMT IO) DeBruijnPattern
-> [NamesT (TCMT IO) DeBruijnPattern]
-> [NamesT (TCMT IO) DeBruijnPattern]
forall a. a -> [a] -> [a]
:[NamesT (TCMT IO) DeBruijnPattern]
Vars (TCMT IO)
p)] [NamesT (TCMT IO) DeBruijnPattern]
-> [NamesT (TCMT IO) DeBruijnPattern]
-> [NamesT (TCMT IO) DeBruijnPattern]
forall a. [a] -> [a] -> [a]
++ [NamesT (TCMT IO) DeBruijnPattern]
Vars (TCMT IO)
d)

      rhsTy :: NamesT (TCMT IO) (Dom Type)
rhsTy = NamesT (TCMT IO) (AbsN (Dom Type))
old_ty NamesT (TCMT IO) (AbsN (Dom Type))
-> [NamesT (TCMT IO) (SubstArg (Dom Type))]
-> NamesT (TCMT IO) (Dom Type)
forall (m :: * -> *) a.
(Monad m, Subst a) =>
NamesT m (AbsN a) -> [NamesT m (SubstArg a)] -> NamesT m a
`applyN` ([NamesT (TCMT IO) Term]
Vars (TCMT IO)
g1 [NamesT (TCMT IO) Term]
-> [NamesT (TCMT IO) Term] -> [NamesT (TCMT IO) Term]
forall a. [a] -> [a] -> [a]
++ [NamesT (TCMT IO) (AbsN (AbsN Term))
pat NamesT (TCMT IO) (AbsN (AbsN Term))
-> [NamesT (TCMT IO) (SubstArg (AbsN Term))]
-> NamesT (TCMT IO) (AbsN Term)
forall (m :: * -> *) a.
(Monad m, Subst a) =>
NamesT m (AbsN a) -> [NamesT m (SubstArg a)] -> NamesT m a
`applyN` [NamesT (TCMT IO) Term]
[NamesT (TCMT IO) (SubstArg (AbsN Term))]
Vars (TCMT IO)
g1_args NamesT (TCMT IO) (AbsN Term)
-> [NamesT (TCMT IO) (SubstArg Term)] -> NamesT (TCMT IO) Term
forall (m :: * -> *) a.
(Monad m, Subst a) =>
NamesT m (AbsN a) -> [NamesT m (SubstArg a)] -> NamesT m a
`applyN` (NamesT (TCMT IO) Term
Var (TCMT IO)
phiNamesT (TCMT IO) Term
-> [NamesT (TCMT IO) Term] -> [NamesT (TCMT IO) Term]
forall a. a -> [a] -> [a]
:[NamesT (TCMT IO) Term]
Vars (TCMT IO)
p)] [NamesT (TCMT IO) Term]
-> [NamesT (TCMT IO) Term] -> [NamesT (TCMT IO) Term]
forall a. [a] -> [a] -> [a]
++ [NamesT (TCMT IO) Term]
Vars (TCMT IO)
d)

    -- (i. Δ[γ1[leftInv (~ i)], pat[leftInv (~i)]])
    delta_f <- (Abs Telescope
-> NamesT (TCMT IO) (NamesT (TCMT IO) (Abs Telescope))
forall (m :: * -> *) a.
(Monad m, Subst a) =>
a -> NamesT m (NamesT m a)
open (Abs Telescope
 -> NamesT (TCMT IO) (NamesT (TCMT IO) (Abs Telescope)))
-> NamesT (TCMT IO) (Abs Telescope)
-> NamesT (TCMT IO) (NamesT (TCMT IO) (Abs Telescope))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (NamesT (TCMT IO) (Abs Telescope)
 -> NamesT (TCMT IO) (NamesT (TCMT IO) (Abs Telescope)))
-> NamesT (TCMT IO) (Abs Telescope)
-> NamesT (TCMT IO) (NamesT (TCMT IO) (Abs Telescope))
forall a b. (a -> b) -> a -> b
$ ShortText
-> (Var (TCMT IO) -> NamesT (TCMT IO) Telescope)
-> NamesT (TCMT IO) (Abs Telescope)
forall (m :: * -> *) a.
Monad m =>
ShortText
-> ((forall b. (Subst b, DeBruijn b) => NamesT m b) -> NamesT m a)
-> NamesT m (Abs a)
bind ShortText
"i" ((Var (TCMT IO) -> NamesT (TCMT IO) Telescope)
 -> NamesT (TCMT IO) (Abs Telescope))
-> (Var (TCMT IO) -> NamesT (TCMT IO) Telescope)
-> NamesT (TCMT IO) (Abs Telescope)
forall a b. (a -> b) -> a -> b
$ \ Var (TCMT IO)
i -> do
      let ni :: NamesT (TCMT IO) Term
ni = NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall {m :: * -> *}.
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
NamesT m Term -> NamesT m Term
neg NamesT (TCMT IO) Term
Var (TCMT IO)
i
      dargs <- ((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
$ do
        xs <- Abs [Term] -> Term -> [Term]
Abs [Term] -> SubstArg [Term] -> [Term]
forall a. Subst a => Abs a -> SubstArg a -> a
absApp (Abs [Term] -> Term -> [Term])
-> NamesT (TCMT IO) (Abs [Term])
-> NamesT (TCMT IO) (Term -> [Term])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamesT (TCMT IO) (Abs [Term])
g1_left NamesT (TCMT IO) (Term -> [Term])
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) [Term]
forall a b.
NamesT (TCMT IO) (a -> b)
-> NamesT (TCMT IO) a -> NamesT (TCMT IO) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> NamesT (TCMT IO) Term
ni
        y <- absApp <$> pat_left <*> ni
        return $ xs ++ [y]
      delta `applyN` dargs

    --  trFillTel (i. Δ[γ1[leftInv (~ i)], pat[leftInv (~i)]]) φ δ
    d_f <- (open =<<) $ bind "i" $ \ Var (TCMT IO)
i -> do
      delta_f <- NamesT (TCMT IO) (Abs Telescope)
delta_f
      phi <- phi
      d <- map defaultArg <$> sequence d
      i <- i
      lift $ covFillTele f delta_f phi d i

    -- w = Def f (old_ps[g1_left[i],pat_left[i],d_f[~ i]])
    w <- (open =<<) $ bind "i" $ \ Var (TCMT IO)
i -> do
      psargs <- ((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
$ do
        xs <- Abs [Term] -> Term -> [Term]
Abs [Term] -> SubstArg [Term] -> [Term]
forall a. Subst a => Abs a -> SubstArg a -> a
absApp (Abs [Term] -> Term -> [Term])
-> NamesT (TCMT IO) (Abs [Term])
-> NamesT (TCMT IO) (Term -> [Term])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamesT (TCMT IO) (Abs [Term])
g1_left NamesT (TCMT IO) (Term -> [Term])
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) [Term]
forall a b.
NamesT (TCMT IO) (a -> b)
-> NamesT (TCMT IO) a -> NamesT (TCMT IO) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> NamesT (TCMT IO) Term
Var (TCMT IO)
i
        y <- absApp <$> pat_left <*> i
        zs <- absApp <$> d_f <*> neg i
        return $ xs ++ [y] ++ zs
      ps <- (fmap patternsToElims <$> old_ps) `applyN` psargs
      pure $ Def f ps


    -- (i. old_t[γ1[leftInv i],x = pat[leftInv i], δ_f[~i]])
    ty <- (open =<<) $ bind "i" $ \ Var (TCMT IO)
i -> do
      tyargs <- ((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
$ do
        xs <- Abs [Term] -> Term -> [Term]
Abs [Term] -> SubstArg [Term] -> [Term]
forall a. Subst a => Abs a -> SubstArg a -> a
absApp (Abs [Term] -> Term -> [Term])
-> NamesT (TCMT IO) (Abs [Term])
-> NamesT (TCMT IO) (Term -> [Term])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamesT (TCMT IO) (Abs [Term])
g1_left NamesT (TCMT IO) (Term -> [Term])
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) [Term]
forall a b.
NamesT (TCMT IO) (a -> b)
-> NamesT (TCMT IO) a -> NamesT (TCMT IO) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> NamesT (TCMT IO) Term
Var (TCMT IO)
i
        y <- absApp <$> pat_left <*> i
        zs <- absApp <$> d_f <*> neg i
        return $ xs ++ [y] ++ zs
      fmap unDom $ old_ty `applyN` tyargs

    sys <- do
      sides <- do
        neg <- primINeg
        io <- primIOne
        vs <- iApplyVars <$> ps
        tm <- w
        xs <- forM vs $ \ Int
v ->
            -- have to reduce these under the appropriate substitutions, otherwise non-normalizing(?)
              ((Abs Term, Abs Term) -> (Term, (Abs Term, Abs Term)))
-> NamesT (TCMT IO) (Abs Term, Abs Term)
-> NamesT (TCMT IO) (Term, (Abs Term, Abs 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 (Int -> Term
var Int
v,) (NamesT (TCMT IO) (Abs Term, Abs Term)
 -> NamesT (TCMT IO) (Term, (Abs Term, Abs Term)))
-> ((Abs Term, Abs Term) -> NamesT (TCMT IO) (Abs Term, Abs Term))
-> (Abs Term, Abs Term)
-> NamesT (TCMT IO) (Term, (Abs Term, Abs Term))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Abs Term, Abs Term) -> NamesT (TCMT IO) (Abs Term, Abs Term)
forall a (m :: * -> *). (Reduce a, MonadReduce m) => a -> m a
reduce ((Abs Term, Abs Term)
 -> NamesT (TCMT IO) (Term, (Abs Term, Abs Term)))
-> (Abs Term, Abs Term)
-> NamesT (TCMT IO) (Term, (Abs Term, Abs Term))
forall a b. (a -> b) -> a -> b
$ (Int -> Term -> Substitution
forall a. EndoSubst a => Int -> a -> Substitution' a
inplaceS Int
v Term
iz Substitution' (SubstArg (Abs Term)) -> Abs Term -> Abs Term
forall a. Subst a => Substitution' (SubstArg a) -> a -> a
`applySubst` Abs Term
tm, Int -> Term -> Substitution
forall a. EndoSubst a => Int -> a -> Substitution' a
inplaceS Int
v Term
io Substitution' (SubstArg (Abs Term)) -> Abs Term -> Abs Term
forall a. Subst a => Substitution' (SubstArg a) -> a -> a
`applySubst` Abs Term
tm)
        return $ concatMap (\(Term
v,(Abs Term
l,Abs Term
r)) -> [(Term
neg Term -> Args -> Term
forall t. Apply t => t -> Args -> t
`apply` [Term -> Arg Term
forall e. e -> Arg e
argN Term
v],Abs Term
l),(Term
v,Abs Term
r)]) xs
      forM sides $ \ (Term
psi,Abs Term
u') -> do
        u' <- Abs Term -> NamesT (TCMT IO) (NamesT (TCMT IO) (Abs Term))
forall (m :: * -> *) a.
(Monad m, Subst a) =>
a -> NamesT m (NamesT m a)
open Abs Term
u'
        u <- lam "i" $ \ NamesT (TCMT IO) Term
i -> ShortText
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall (m :: * -> *).
Monad m =>
ShortText -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
lam ShortText
"o" ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
 -> NamesT (TCMT IO) Term)
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall a b. (a -> b) -> a -> b
$ \ NamesT (TCMT IO) Term
o -> Abs Term -> Term -> Term
Abs Term -> SubstArg Term -> Term
forall a. Subst a => Abs a -> SubstArg a -> a
absApp (Abs Term -> Term -> Term)
-> NamesT (TCMT IO) (Abs Term) -> NamesT (TCMT IO) (Term -> Term)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamesT (TCMT IO) (Abs Term)
u' NamesT (TCMT IO) (Term -> Term)
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall a b.
NamesT (TCMT IO) (a -> b)
-> NamesT (TCMT IO) a -> NamesT (TCMT IO) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> NamesT (TCMT IO) Term
i
        (,) <$> open psi <*> open u

    let rhs = NamesT (TCMT IO) (Abs Type)
-> [(NamesT (TCMT IO) Term, NamesT (TCMT IO) Term)]
-> NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term
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 (TCMT IO) (Abs Type)
ty [(NamesT (TCMT IO) Term, NamesT (TCMT IO) Term)]
sys NamesT (TCMT IO) Term
Var (TCMT IO)
phi (Abs Term -> Term -> Term
Abs Term -> SubstArg Term -> Term
forall a. Subst a => Abs a -> SubstArg a -> a
absApp (Abs Term -> Term -> Term)
-> NamesT (TCMT IO) (Abs Term) -> NamesT (TCMT IO) (Term -> Term)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamesT (TCMT IO) (Abs Term)
w NamesT (TCMT IO) (Term -> Term)
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall a b.
NamesT (TCMT IO) (a -> b)
-> NamesT (TCMT IO) a -> NamesT (TCMT IO) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Term -> NamesT (TCMT IO) Term
forall a. a -> NamesT (TCMT IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
iz)

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

  let (ps,ty,rhs) = unAbsN $ unAbsN $ unAbs $ unAbsN $ ps_ty_rhs
  qs <- mapM (fmap (fromMaybe __IMPOSSIBLE__) . getName') [builtinINeg, builtinIMax, builtinIMin]
  rhs <- addContext cTel $
           locallyReduceDefs (OnlyReduceDefs (Set.fromList $ q_trX : qs)) $ normalise rhs
  let cl = Clause { clauseLHSRange :: Range
clauseLHSRange  = Range
forall a. Range' a
noRange
                  , clauseFullRange :: Range
clauseFullRange = Range
forall a. Range' a
noRange
                  , clauseTel :: Telescope
clauseTel       = Telescope
cTel
                  , namedClausePats :: [NamedArg DeBruijnPattern]
namedClausePats = [NamedArg DeBruijnPattern]
ps
                  , clauseBody :: Maybe Term
clauseBody      = Term -> Maybe Term
forall a. a -> Maybe a
Just Term
rhs
                  , clauseType :: Maybe (Arg Type)
clauseType      = Arg Type -> Maybe (Arg Type)
forall a. a -> Maybe a
Just (Arg Type -> Maybe (Arg Type)) -> Arg Type -> Maybe (Arg Type)
forall a b. (a -> b) -> a -> b
$ ArgInfo -> Type -> Arg Type
forall e. ArgInfo -> e -> Arg e
Arg (Dom Type -> ArgInfo
forall a. LensArgInfo a => a -> ArgInfo
getArgInfo Dom Type
ty) (Dom Type -> Type
forall t e. Dom' t e -> e
unDom Dom Type
ty)
                  , clauseCatchall :: Catchall
clauseCatchall    = Catchall
forall a. Null a => a
empty
                  , clauseRecursive :: ClauseRecursive
clauseRecursive   = ClauseRecursive
YesRecursive
                  , clauseUnreachable :: Maybe Bool
clauseUnreachable = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False
                  , clauseEllipsis :: ExpandedEllipsis
clauseEllipsis    = ExpandedEllipsis
NoEllipsis
                  , clauseWhereModule :: Maybe ModuleName
clauseWhereModule = Maybe ModuleName
forall a. Maybe a
Nothing
                  }


  debugClause "tc.cover.trxcon" cl

  reportSDoc "tc.cover.trxcon" 20 $ vcat $
    [ "clause:"
    ,  nest 2 $ prettyTCM . QNamed f $ cl
    ]

  return cl

{-
  OLD leftInv case
  -- Γ,(φ : I),(p : Path A u v) ⊢ leftInv : ρ[τ] ≡ wkS 2 : Γ
  -- Γ,(φ : I),(p : Path A u v)(i : I) ⊢ leftInv i : Γ
  -- Γ,(φ : I),(p : Path A u v) ⊢ leftInv i0 = ρ[τ] : Γ
  -- Γ,(φ : I),(p : Path A u v) ⊢ leftInv i1 = wkS 2 : Γ
  -- leftInv[φ = i1][i] = wkS 2

  -- Γ,(φ : I),(p : Path A u v),Δ[ρ,x = refl][τ] ⊢ τ' = liftS |Δ[ρ,x = refl]| τ : Γ',Δ[ρ,x = refl]

  -- Γ,(φ : I),(p : Path A u v),Δ[ρ,x = refl][τ] ⊢ w = f old_ps[ρ,x = refl][τ'] : old_t[ρ,x = refl][τ']

  -- Γ,(φ : I),(p : Path A u v) | (i : I) ⊢ μ = ⟨ (φ ∨ ~ i) , (\ j → p (i ∧ j)) ⟩ : Id A u (p i) =?= (Id A u v)[leftInv (~ i)]
                                  μ[0] = ⟨ 1 , (\ _ → u[ρ[τ]]) ⟩
                                  μ[1] = ⟨ φ , p               ⟩
  -- Γ,(φ : I),(p : Path A u v),(δ : Δ[x = ⟨ φ , p ⟩]) ⊢ vecTransp (i. Δ[leftInv (~ i),μ[i]]) φ δ : Δ[ρ[τ], x = refl u[ρ[τ]]]
-}

-- | Append an hcomp clause to the clauses of a function.
createMissingHCompClause ::
     QName
       -- ^ Function name.
  -> Arg Nat
       -- ^ index of hcomp pattern
  -> BlockingVar
       -- ^ Blocking var that lead to hcomp split.
  -> SplitClause
       -- ^ Clause before the hcomp split
  -> SplitClause
       -- ^ Clause to add.
  -> [Clause]
   -> TCM ([(SplitTag,CoverResult)], [Clause])
createMissingHCompClause :: QName
-> Arg Int
-> BlockingVar
-> SplitClause
-> SplitClause
-> [Clause]
-> TCM ([(SplitTag, CoverResult)], [Clause])
createMissingHCompClause QName
f Arg Int
n BlockingVar
x SplitClause
old_sc (SClause Telescope
tel [NamedArg SplitPattern]
ps Substitution' SplitPattern
_sigma' Map CheckpointId Substitution
_cps (Just Dom Type
t)) [Clause]
cs = QName
-> TCM ([(SplitTag, CoverResult)], [Clause])
-> TCM ([(SplitTag, CoverResult)], [Clause])
forall (m :: * -> *) x a.
(MonadTrace m, HasRange x) =>
x -> m a -> m a
setCurrentRange QName
f (TCM ([(SplitTag, CoverResult)], [Clause])
 -> TCM ([(SplitTag, CoverResult)], [Clause]))
-> TCM ([(SplitTag, CoverResult)], [Clause])
-> TCM ([(SplitTag, CoverResult)], [Clause])
forall a b. (a -> b) -> a -> b
$ do
  VerboseKey -> Int -> TCMT IO Doc -> TCMT IO ()
forall (m :: * -> *).
MonadDebug m =>
VerboseKey -> Int -> TCMT IO Doc -> m ()
reportSDoc VerboseKey
"tc.cover.hcomp" Int
20 (TCMT IO Doc -> TCMT IO ()) -> TCMT IO Doc -> TCMT IO ()
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
tel (TCMT IO Doc -> TCMT IO Doc) -> TCMT IO Doc -> TCMT IO Doc
forall a b. (a -> b) -> a -> b
$ VerboseKey -> TCMT IO Doc
forall (m :: * -> *). Applicative m => VerboseKey -> m Doc
text VerboseKey
"Trying to create right-hand side of type" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> Dom Type -> TCMT IO Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
forall (m :: * -> *). MonadPretty m => Dom Type -> m Doc
prettyTCM Dom Type
t
  VerboseKey -> Int -> TCMT IO Doc -> TCMT IO ()
forall (m :: * -> *).
MonadDebug m =>
VerboseKey -> Int -> TCMT IO Doc -> m ()
reportSDoc VerboseKey
"tc.cover.hcomp" Int
30 (TCMT IO Doc -> TCMT IO ()) -> TCMT IO Doc -> TCMT IO ()
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
tel (TCMT IO Doc -> TCMT IO Doc) -> TCMT IO Doc -> TCMT IO Doc
forall a b. (a -> b) -> a -> b
$ VerboseKey -> TCMT IO Doc
forall (m :: * -> *). Applicative m => VerboseKey -> m Doc
text VerboseKey
"ps = " TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> [NamedArg DeBruijnPattern] -> TCMT IO Doc
forall (m :: * -> *).
MonadPretty m =>
[NamedArg DeBruijnPattern] -> m Doc
prettyTCMPatternList ([NamedArg SplitPattern] -> [NamedArg DeBruijnPattern]
fromSplitPatterns [NamedArg SplitPattern]
ps)
  VerboseKey -> Int -> TCMT IO Doc -> TCMT IO ()
forall (m :: * -> *).
MonadDebug m =>
VerboseKey -> Int -> TCMT IO Doc -> m ()
reportSDoc VerboseKey
"tc.cover.hcomp" Int
30 (TCMT IO Doc -> TCMT IO ()) -> TCMT IO Doc -> TCMT IO ()
forall a b. (a -> b) -> a -> b
$ VerboseKey -> TCMT IO Doc
forall (m :: * -> *). Applicative m => VerboseKey -> m Doc
text VerboseKey
"tel = " TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> Telescope -> TCMT IO Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
forall (m :: * -> *). MonadPretty m => Telescope -> m Doc
prettyTCM Telescope
tel

  io      <- Term -> Maybe Term -> Term
forall a. a -> Maybe a -> a
fromMaybe Term
forall a. HasCallStack => a
__IMPOSSIBLE__ (Maybe Term -> Term) -> TCMT IO (Maybe Term) -> TCMT IO Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BuiltinId -> TCMT IO (Maybe Term)
forall (m :: * -> *) a.
(HasBuiltins m, IsBuiltin a) =>
a -> m (Maybe Term)
getTerm' BuiltinId
builtinIOne
  iz      <- fromMaybe __IMPOSSIBLE__ <$> getTerm' builtinIZero
  let
    cannotCreate :: MonadTCError m => Doc -> Closure (Abs Type) -> m a
    cannotCreate Doc
doc Closure (Abs Type)
t = do
      SplitError -> m a
forall (m :: * -> *) e a.
(HasCallStack, MonadTCError m, Diagnostic e) =>
e -> m a
typeError (SplitError -> m a) -> SplitError -> m a
forall a b. (a -> b) -> a -> b
$ QName
-> (Telescope, [NamedArg DeBruijnPattern])
-> Doc
-> Closure (Abs Type)
-> SplitError
CannotCreateMissingClause QName
f (Telescope
tel,[NamedArg SplitPattern] -> [NamedArg DeBruijnPattern]
fromSplitPatterns [NamedArg SplitPattern]
ps) Doc
doc Closure (Abs Type)
t
  let old_ps = [NamedArg DeBruijnPattern] -> [Elim]
patternsToElims ([NamedArg DeBruijnPattern] -> [Elim])
-> [NamedArg DeBruijnPattern] -> [Elim]
forall a b. (a -> b) -> a -> b
$ [NamedArg SplitPattern] -> [NamedArg DeBruijnPattern]
fromSplitPatterns ([NamedArg SplitPattern] -> [NamedArg DeBruijnPattern])
-> [NamedArg SplitPattern] -> [NamedArg DeBruijnPattern]
forall a b. (a -> b) -> a -> b
$ SplitClause -> [NamedArg SplitPattern]
scPats SplitClause
old_sc
      old_t  = Maybe (Dom Type) -> Dom Type
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (Dom Type) -> Dom Type) -> Maybe (Dom Type) -> Dom Type
forall a b. (a -> b) -> a -> b
$ SplitClause -> Maybe (Dom Type)
scTarget SplitClause
old_sc
      old_tel = SplitClause -> Telescope
scTel SplitClause
old_sc
      -- old_tel = Γ(x:H)Δ
      -- Γ(x:H)Δ ⊢ old_t
      -- vs = iApplyVars old_ps
      -- [ α ⇒ b ] = [(i,f old_ps (i=0),f old_ps (i=1)) | i <- vs]

      -- Γ(x:H)(δ : Δ) ⊢ [ α ⇒ b ]
      -- Γ(x:H)Δ ⊢ f old_ps : old_t [ α ⇒ b ]
      -- Γ,φ,u,u0,Δ(x = hcomp φ u u0) ⊢ rhs_we_define : (old_t[ α ⇒ b ])(x = hcomp φ u u0)

      -- Extra assumption:
      -- tel = Γ,φ,u,u0,Δ(x = hcomp φ u u0),Δ'
      -- ps = old_ps[x = hcomp φ u u0],ps'
      -- with Δ' and ps' introduced by fixTarget.
      -- So final clause will be:
      -- tel ⊢ ps ↦ rhs_we_define{wkS ..} ps'

      getLevel Type
t = do
        s <- Sort -> TCMT IO Sort
forall a (m :: * -> *). (Reduce a, MonadReduce m) => a -> m a
reduce (Sort -> TCMT IO Sort) -> Sort -> TCMT IO Sort
forall a b. (a -> b) -> a -> b
$ Type -> Sort
forall a. LensSort a => a -> Sort
getSort Type
t
        case s of
          Type Level
l -> Term -> TCMT IO Term
forall a. a -> TCMT IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Level -> Term
Level Level
l)

          -- Impossible since we only have HITs in Type:
          Sort
s -> do
            VerboseKey -> Int -> TCMT IO Doc -> TCMT IO ()
forall (m :: * -> *).
MonadDebug m =>
VerboseKey -> Int -> TCMT IO Doc -> m ()
reportSDoc VerboseKey
"tc.cover.hcomp" Int
20 (TCMT IO Doc -> TCMT IO ()) -> TCMT IO Doc -> TCMT IO ()
forall a b. (a -> b) -> a -> b
$ [TCMT IO Doc] -> TCMT IO Doc
forall (m :: * -> *) (t :: * -> *).
(Applicative m, Foldable t) =>
t (m Doc) -> m Doc
vcat
              [ TCMT IO Doc
"sort of blocking variable when creating hcomp clause is not Type"
              , Int -> TCMT IO Doc -> TCMT IO Doc
forall (m :: * -> *). Functor m => Int -> m Doc -> m Doc
nest Int
2 (TCMT IO Doc
"t =" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> Type -> TCMT IO Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
forall (m :: * -> *). MonadPretty m => Type -> m Doc
prettyTCM Type
t)
              , Int -> TCMT IO Doc -> TCMT IO Doc
forall (m :: * -> *). Functor m => Int -> m Doc -> m Doc
nest Int
2 (TCMT IO Doc
"s =" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> Sort -> TCMT IO Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
forall (m :: * -> *). MonadPretty m => Sort -> m Doc
prettyTCM Sort
s)
              , TCMT IO Doc
""
              , TCMT IO Doc
"clause:"
              , Int -> TCMT IO Doc -> TCMT IO Doc
forall (m :: * -> *). Functor m => Int -> m Doc -> m Doc
nest Int
2 (TCMT IO Doc -> TCMT IO Doc) -> TCMT IO Doc -> TCMT IO Doc
forall a b. (a -> b) -> a -> b
$ QNamed Clause -> TCMT IO Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
forall (m :: * -> *). MonadPretty m => QNamed Clause -> m Doc
prettyTCM (QName -> Clause -> QNamed Clause
forall a. QName -> a -> QNamed a
QNamed QName
f Clause
forall a. Null a => a
empty{ clauseTel = tel, namedClausePats = fromSplitPatterns ps })
              ]
            TCMT IO Term
forall a. HasCallStack => a
__IMPOSSIBLE__

      -- Γ ⊢ hdelta = (x : H)(δ : Δ)
      (gamma,hdelta@(ExtendTel hdom delta)) = splitTelescopeAt (size old_tel - (blockingVarNo x + 1)) old_tel

      -- Γ,φ,u,u0,Δ(x = hcomp φ u u0) ⊢
      (working_tel,_deltaEx) = splitTelescopeAt (size gamma + 3 + size delta) tel

      -- Γ,φ,u,u0,(x:H)(δ : Δ) ⊢ rhoS : Γ(x:H)(δ : Δ)
      {- rhoS = liftS (size hdelta) $ raiseS 3 -}
      vs = [NamedArg SplitPattern] -> [Int]
forall p. IApplyVars p => p -> [Int]
iApplyVars (SplitClause -> [NamedArg SplitPattern]
scPats SplitClause
old_sc)

  -- Γ(x:H)(δ : Δ) ⊢ [ α ⇒ b ] = [(i,f old_ps (i=0),f old_ps (i=1)) | i <- vs]
  alphab <- forM vs \ Int
i -> do
    let
      -- Γ(x:H)(δ : Δ) ⊢
      tm :: Term
tm = QName -> [Elim] -> Term
Def QName
f [Elim]
old_ps
    -- TODO only reduce IApply _ _ (0/1), as to avoid termination problems
    (l,r) <- (Term, Term) -> TCMT IO (Term, Term)
forall a (m :: * -> *). (Reduce a, MonadReduce m) => a -> m a
reduce (Int -> Term -> Substitution
forall a. EndoSubst a => Int -> a -> Substitution' a
inplaceS Int
i Term
iz Substitution' (SubstArg Term) -> Term -> Term
forall a. Subst a => Substitution' (SubstArg a) -> a -> a
`applySubst` Term
tm, Int -> Term -> Substitution
forall a. EndoSubst a => Int -> a -> Substitution' a
inplaceS Int
i Term
io Substitution' (SubstArg Term) -> Term -> Term
forall a. Subst a => Substitution' (SubstArg a) -> a -> a
`applySubst` Term
tm)
    return $ (var i, (l, r))

  cl <- do
    (ty,rhs) <- addContext working_tel $ do
      -- Γ(x:H)Δ ⊢ g = f old_ps : old_t [ α ⇒ b ]
      -- Γ(x:H)(δ : Δ) ⊢ [ α ⇒ b ]
      -- Γ,φ,u,u0 ⊢ Δf = i.Δ[x = hfill φ u u0 i]
      -- Γ,φ,u,u0,δ : Δ(x = hcomp φ u u0) ⊢ δ_fill     = i.tFillTel (i. Δf[~i]) δ (~ i) : i.Δf[i]
      -- Γ,φ,u,u0,δ : Δ(x = hcomp φ u u0) ⊢ old_t_fill = i.old_t[x = hfill φ u u0 i, δ_fill[i]]
      -- Γ,φ,u,u0,δ : Δ(x = hcomp φ u u0) ⊢ comp (\ i. old_t_fill[i])
      --                 (\ i. [ φ ↦ g[x = hfill φ u u0 i,δ_fill[i]] = g[u i,δ_fill[i]]
      --                         α ↦ b[x = hfill φ u u0 i,δ_fill[i]]
      --                        ])
      --                 (g[x = u0,δ_fill[0]]) : old_t[x = hcomp φ u u0,δ]

      runNamesT [] $ do
        tPOr <- fromMaybe __IMPOSSIBLE__ <$> getTerm' builtinPOr
        tIMax <- fromMaybe __IMPOSSIBLE__ <$> getTerm' builtinIMax
        tIMin <- fromMaybe __IMPOSSIBLE__ <$> getTerm' builtinIMin
        tINeg <- fromMaybe __IMPOSSIBLE__ <$> getTerm' builtinINeg
        tHComp <- fromMaybe __IMPOSSIBLE__ <$> getTerm' builtinHComp
        tTrans <- fromMaybe __IMPOSSIBLE__ <$> getTerm' builtinTrans
        extra_ps <- open $ patternsToElims $ fromSplitPatterns $ drop (length old_ps) ps
        let
          ineg NamesT (TCMT IO) Term
j = Term -> NamesT (TCMT IO) Term
forall a. a -> NamesT (TCMT IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
tINeg NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT (TCMT IO) Term
j
          imax NamesT (TCMT IO) Term
i NamesT (TCMT IO) Term
j = Term -> NamesT (TCMT IO) Term
forall a. a -> NamesT (TCMT IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
tIMax NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT (TCMT IO) Term
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
          trFillTel' t (TCMT IO) (Abs Telescope)
a t (TCMT IO) Term
b t (TCMT IO) Args
c t (TCMT IO) Term
d = do
            m <- Abs Telescope
-> Term
-> Args
-> Term
-> ExceptT (Closure (Abs Type)) (TCMT IO) Args
trFillTel (Abs Telescope
 -> Term
 -> Args
 -> Term
 -> ExceptT (Closure (Abs Type)) (TCMT IO) Args)
-> t (TCMT IO) (Abs Telescope)
-> t (TCMT IO)
     (Term
      -> Args -> Term -> ExceptT (Closure (Abs Type)) (TCMT IO) Args)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> t (TCMT IO) (Abs Telescope)
a t (TCMT IO)
  (Term
   -> Args -> Term -> ExceptT (Closure (Abs Type)) (TCMT IO) Args)
-> t (TCMT IO) Term
-> t (TCMT IO)
     (Args -> Term -> ExceptT (Closure (Abs Type)) (TCMT IO) Args)
forall a b. t (TCMT IO) (a -> b) -> t (TCMT IO) a -> t (TCMT IO) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> t (TCMT IO) Term
b t (TCMT IO)
  (Args -> Term -> ExceptT (Closure (Abs Type)) (TCMT IO) Args)
-> t (TCMT IO) Args
-> t (TCMT IO)
     (Term -> ExceptT (Closure (Abs Type)) (TCMT IO) Args)
forall a b. t (TCMT IO) (a -> b) -> t (TCMT IO) a -> t (TCMT IO) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> t (TCMT IO) Args
c t (TCMT IO) (Term -> ExceptT (Closure (Abs Type)) (TCMT IO) Args)
-> t (TCMT IO) Term
-> t (TCMT IO) (ExceptT (Closure (Abs Type)) (TCMT IO) Args)
forall a b. t (TCMT IO) (a -> b) -> t (TCMT IO) a -> t (TCMT IO) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> t (TCMT IO) Term
d
            x <- lift $ runExceptT m
            case x of
              Left Closure (Abs Type)
bad_t -> Doc -> Closure (Abs Type) -> t (TCMT IO) Args
forall (m :: * -> *) a.
MonadTCError m =>
Doc -> Closure (Abs Type) -> m a
cannotCreate Doc
"Cannot transport with type family:" Closure (Abs Type)
bad_t
              Right Args
args -> Args -> t (TCMT IO) Args
forall a. a -> t (TCMT IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return Args
args
        comp <- mkCompLazy "hcompClause"
        let
          hcomp NamesT (TCMT IO) Term
la NamesT (TCMT IO) Term
bA NamesT (TCMT IO) Term
phi NamesT (TCMT IO) Term
u NamesT (TCMT IO) Term
u0 = Term -> NamesT (TCMT IO) Term
forall a. a -> NamesT (TCMT IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
tHComp NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> NamesT (TCMT IO) Term
la NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> NamesT (TCMT IO) Term
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) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT (TCMT IO) Term
u0
          hfill NamesT (TCMT IO) Term
la NamesT (TCMT IO) Term
bA NamesT (TCMT IO) Term
phi NamesT (TCMT IO) Term
u NamesT (TCMT IO) Term
u0 NamesT (TCMT IO) Term
i = NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term
hcomp NamesT (TCMT IO) Term
la NamesT (TCMT IO) Term
bA
            (Term -> NamesT (TCMT IO) Term
forall a. a -> NamesT (TCMT IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
tIMax NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT (TCMT IO) Term
phi NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> (Term -> NamesT (TCMT IO) Term
forall a. a -> NamesT (TCMT IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
tINeg NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT (TCMT IO) Term
i))
            (ShortText
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall (m :: * -> *).
Monad m =>
ShortText -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
lam ShortText
"j" \NamesT (TCMT IO) Term
j -> Term -> NamesT (TCMT IO) Term
forall a. a -> NamesT (TCMT IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
tPOr NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> NamesT (TCMT IO) Term
la
              NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT (TCMT IO) Term
phi NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> (Term -> NamesT (TCMT IO) Term
forall a. a -> NamesT (TCMT IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
tINeg NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT (TCMT IO) Term
i) NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> ShortText
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall (m :: * -> *).
Monad m =>
ShortText -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
lam ShortText
"o" (\ NamesT (TCMT IO) 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
<@> ShortText
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall (m :: * -> *).
Monad m =>
ShortText -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
lam ShortText
"o" (\ NamesT (TCMT IO) Term
o -> NamesT (TCMT IO) Term
u NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> (Term -> NamesT (TCMT IO) Term
forall a. a -> NamesT (TCMT IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
tIMin 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
o)
              NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> ShortText
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall (m :: * -> *).
Monad m =>
ShortText -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
lam ShortText
"o" (\ NamesT (TCMT IO) Term
_ -> NamesT (TCMT IO) Term
u0))
            NamesT (TCMT IO) Term
u0
        -- Γ,φ,u,u0,(δ : Δ(x = hcomp φ u u0)) ⊢ hcompS : Γ(x:H)(δ : Δ)
        hcompS <- lift $ do
          hdom <- pure $ raise 3 hdom
          let
            [phi,u,u0] = map (pure . var) [2,1,0]
            htype = Term -> TCMT IO Term
forall a. a -> TCMT IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term -> TCMT IO Term) -> Term -> TCMT IO Term
forall a b. (a -> b) -> a -> b
$ Type -> Term
forall t a. Type'' t a -> a
unEl (Type -> Term) -> (Dom Type -> Type) -> Dom Type -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dom Type -> Type
forall t e. Dom' t e -> e
unDom (Dom Type -> Term) -> Dom Type -> Term
forall a b. (a -> b) -> a -> b
$ Dom Type
hdom
            lvl = Type -> TCMT IO Term
getLevel (Type -> TCMT IO Term) -> Type -> TCMT IO Term
forall a b. (a -> b) -> a -> b
$ Dom Type -> Type
forall t e. Dom' t e -> e
unDom Dom Type
hdom
          hc <- pure tHComp <#> lvl <#> htype <#> phi <@> u <@> u0
          return $ liftS (size delta) $ hc `consS` raiseS 3
        -- Γ,φ,u,u0,Δ(x = hcomp phi u u0) ⊢ raise 3+|Δ| hdom
        hdom <- pure $ raise (3 + size delta) hdom
        htype <- open $ unEl . unDom $ hdom
        lvl <- open =<< (lift . getLevel $ unDom hdom)

        -- Γ,φ,u,u0,Δ(x = hcomp phi u u0) ⊢
        let vr = 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))
-> (Int -> Term) -> Int -> NamesT (TCMT IO) (NamesT (TCMT IO) Term)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Term -> Term
forall a. Subst a => Int -> a -> a
raise (Abs Telescope -> Int
forall a. Sized a => a -> Int
size Abs Telescope
delta) (Term -> Term) -> (Int -> Term) -> Int -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Term
var
        phi <- vr 2
        u   <- vr 1
        u0  <- vr 0
        -- Γ,x,Δ ⊢ f old_ps
        -- Γ ⊢ abstract hdelta (f old_ps)
        g <- open $ raise (3 + size delta) $ abstract hdelta (Def f old_ps)
        old_t <- open $ raise (3 + size delta) $ abstract hdelta (unDom old_t)
        let bapp f (Abs b)
a f (SubstArg b)
x = Abs b -> SubstArg b -> b
forall a. Subst a => Abs a -> SubstArg a -> a
lazyAbsApp (Abs b -> SubstArg b -> b) -> f (Abs b) -> f (SubstArg b -> b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (Abs b)
a f (SubstArg b -> b) -> f (SubstArg b) -> f b
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f (SubstArg b)
x
        (delta_fill :: NamesT TCM (Abs Args)) <- (open =<<) $ do
          -- Γ,φ,u,u0,Δ(x = hcomp phi u u0) ⊢ x.Δ
          delta <- open $ raise (3 + size delta) delta
          -- Γ,φ,u,u0,Δ(x = hcomp phi u u0) ⊢ i.Δ(x = hfill phi u u0 (~ i))
          deltaf <- open =<< bind "i" (\ Var (TCMT IO)
i ->
                          (NamesT (TCMT IO) (Abs Telescope)
delta NamesT (TCMT IO) (Abs Telescope)
-> NamesT (TCMT IO) (SubstArg Telescope)
-> NamesT (TCMT IO) Telescope
forall {f :: * -> *} {b}.
(Applicative f, Subst b) =>
f (Abs b) -> f (SubstArg b) -> f b
`bapp` NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term
hfill NamesT (TCMT IO) Term
lvl NamesT (TCMT IO) Term
htype NamesT (TCMT IO) Term
phi NamesT (TCMT IO) Term
u NamesT (TCMT IO) Term
u0 (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
ineg NamesT (TCMT IO) Term
Var (TCMT IO)
i)))
          -- Γ,φ,u,u0,Δ(x = hcomp phi u u0) ⊢ Δ(x = hcomp phi u u0) = Δf[0]
          args <- (open =<<) $ teleArgs <$> (lazyAbsApp <$> deltaf <*> pure iz)
          bind "i" $ \ Var (TCMT IO)
i -> ShortText -> NamesT (TCMT IO) Args -> NamesT (TCMT IO) Args
forall b (m :: * -> *) a.
(AddContext b, MonadAddContext m) =>
b -> m a -> m a
forall (m :: * -> *) a.
MonadAddContext m =>
ShortText -> m a -> m a
addContext (ShortText
"i" :: ShortText) (NamesT (TCMT IO) Args -> NamesT (TCMT IO) Args)
-> NamesT (TCMT IO) Args -> NamesT (TCMT IO) Args
forall a b. (a -> b) -> a -> b
$ do -- for error messages.
            -- Γ,φ,u,u0,Δ(x = hcomp phi u u0),(i:I) ⊢ ... : Δ(x = hfill phi u u0 i)
            NamesT (TCMT IO) (Abs Telescope)
-> NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Args
-> NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Args
forall {t :: (* -> *) -> * -> *}.
(MonadTrans t, MonadTCEnv (t (TCMT IO)), ReadTCState (t (TCMT IO)),
 MonadError TCErr (t (TCMT IO))) =>
t (TCMT IO) (Abs Telescope)
-> t (TCMT IO) Term
-> t (TCMT IO) Args
-> t (TCMT IO) Term
-> t (TCMT IO) Args
trFillTel' NamesT (TCMT IO) (Abs Telescope)
deltaf (Term -> NamesT (TCMT IO) Term
forall a. a -> NamesT (TCMT IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
iz) NamesT (TCMT IO) Args
args (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
ineg NamesT (TCMT IO) Term
Var (TCMT IO)
i)
        let
          apply_delta_fill NamesT (TCMT IO) Term
i NamesT (TCMT IO) Term
f = Term -> Args -> Term
forall t. Apply t => t -> Args -> t
apply (Term -> Args -> Term)
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) (Args -> Term)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamesT (TCMT IO) Term
f NamesT (TCMT IO) (Args -> Term)
-> NamesT (TCMT IO) Args -> NamesT (TCMT IO) Term
forall a b.
NamesT (TCMT IO) (a -> b)
-> NamesT (TCMT IO) a -> NamesT (TCMT IO) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (NamesT (TCMT IO) (Abs Args)
delta_fill NamesT (TCMT IO) (Abs Args)
-> NamesT (TCMT IO) (SubstArg Args) -> NamesT (TCMT IO) Args
forall {f :: * -> *} {b}.
(Applicative f, Subst b) =>
f (Abs b) -> f (SubstArg b) -> f b
`bapp` NamesT (TCMT IO) Term
NamesT (TCMT IO) (SubstArg Args)
i)
          call NamesT (TCMT IO) Term
v NamesT (TCMT IO) Term
i = NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
apply_delta_fill NamesT (TCMT IO) Term
i (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
g 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
v
          ty NamesT (TCMT IO) Term
i = do
            v <- NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term
hfill NamesT (TCMT IO) Term
lvl NamesT (TCMT IO) Term
htype NamesT (TCMT IO) Term
phi NamesT (TCMT IO) Term
u NamesT (TCMT IO) Term
u0 NamesT (TCMT IO) Term
i
            hd <- old_t
            args <- delta_fill `bapp` i
            lift $ piApplyM hd $ Arg (domInfo hdom) v : args

        ty_level <- do
          t <- bind "i" $ \ Var (TCMT IO)
x -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
ty NamesT (TCMT IO) Term
Var (TCMT IO)
x
          s <- reduce $ getSort (absBody t)
          reportSDoc "tc.cover.hcomp" 20 $ text "ty_level, s = " <+> prettyTCM s
          case s of
            Type Level
l -> 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
=<< ShortText
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall (m :: * -> *).
Monad m =>
ShortText -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
lam ShortText
"i" (\ NamesT (TCMT IO) Term
_ -> Term -> NamesT (TCMT IO) Term
forall a. a -> NamesT (TCMT IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term -> NamesT (TCMT IO) Term) -> Term -> NamesT (TCMT IO) Term
forall a b. (a -> b) -> a -> b
$ Level -> Term
Level Level
l)
            Sort
_      -> do
              cl <- TCMT IO (Closure (Abs Type))
-> NamesT (TCMT IO) (Closure (Abs Type))
forall a. TCM a -> NamesT (TCMT IO) a
forall (tcm :: * -> *) a. MonadTCM tcm => TCM a -> tcm a
liftTCM (Abs Type -> TCMT IO (Closure (Abs Type))
forall (m :: * -> *) a.
(MonadTCEnv m, ReadTCState m) =>
a -> m (Closure a)
buildClosure Abs Type
t)
              liftTCM (cannotCreate "Cannot compose with type family:" cl)

        let
          pOr_ty NamesT (TCMT IO) Term
i NamesT (TCMT IO) Term
phi NamesT (TCMT IO) Term
psi NamesT (TCMT IO) Term
u0 NamesT (TCMT IO) Term
u1 = Term -> NamesT (TCMT IO) Term
forall a. a -> NamesT (TCMT IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
tPOr NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> (NamesT (TCMT IO) Term
ty_level 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
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
psi
                                              NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> ShortText
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall (m :: * -> *).
Monad m =>
ShortText -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
lam ShortText
"o" (\ NamesT (TCMT IO) Term
_ -> Type -> Term
forall t a. Type'' t a -> a
unEl (Type -> Term) -> NamesT (TCMT IO) Type -> NamesT (TCMT IO) Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
ty 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
u0 NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT (TCMT IO) Term
u1
        alpha <- do
          vars <- mapM (open . applySubst hcompS . fst) alphab
          return $ foldr (imax . (\ NamesT (TCMT IO) Term
v -> NamesT (TCMT IO) Term
v NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
`imax` NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
ineg NamesT (TCMT IO) Term
v)) (pure iz) vars

        -- Γ,φ,u,u0,Δ(x = hcomp φ u u0) ⊢ b : (i : I) → [α] -> old_t[x = hfill φ u u0 i,δ_fill[i]]
        b <- do
            sides <- forM alphab $ \ (Term
psi,(Term
side0,Term
side1)) -> do
              psi <- Term -> NamesT (TCMT IO) (NamesT (TCMT IO) Term)
forall (m :: * -> *) a.
(Monad m, Subst a) =>
a -> NamesT m (NamesT m a)
open (Term -> NamesT (TCMT IO) (NamesT (TCMT IO) Term))
-> Term -> NamesT (TCMT IO) (NamesT (TCMT IO) Term)
forall a b. (a -> b) -> a -> b
$ Substitution
Substitution' (SubstArg Term)
hcompS Substitution' (SubstArg Term) -> Term -> Term
forall a. Subst a => Substitution' (SubstArg a) -> a -> a
`applySubst` Term
psi
              let f = Term -> NamesT (TCMT IO) (NamesT (TCMT IO) Term)
forall (m :: * -> *) a.
(Monad m, Subst a) =>
a -> NamesT m (NamesT m a)
open (Term -> NamesT (TCMT IO) (NamesT (TCMT IO) Term))
-> (Term -> Term)
-> Term
-> NamesT (TCMT IO) (NamesT (TCMT IO) Term)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Term -> Term
forall a. Subst a => Int -> a -> a
raise (Int
3 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Abs Telescope -> Int
forall a. Sized a => a -> Int
size Abs Telescope
delta) (Term -> Term) -> (Term -> Term) -> Term -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Telescope -> Term -> Term
forall t. Abstract t => Telescope -> t -> t
abstract Telescope
hdelta
              side0 <- f side0
              side1 <- f side1
              return $ (ineg psi `imax` psi, \ NamesT (TCMT IO) Term
i -> NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term
pOr_ty NamesT (TCMT IO) Term
i (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
ineg NamesT (TCMT IO) Term
psi) NamesT (TCMT IO) Term
psi (ShortText
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall (m :: * -> *).
Monad m =>
ShortText -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
lam ShortText
"o" ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
 -> NamesT (TCMT IO) Term)
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall a b. (a -> b) -> a -> b
$ \ NamesT (TCMT IO) Term
_ -> NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
apply_delta_fill NamesT (TCMT IO) Term
i (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
side0 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
-> NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term
hfill NamesT (TCMT IO) Term
lvl NamesT (TCMT IO) Term
htype NamesT (TCMT IO) Term
phi NamesT (TCMT IO) Term
u NamesT (TCMT IO) Term
u0 NamesT (TCMT IO) Term
i)
                                                          (ShortText
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall (m :: * -> *).
Monad m =>
ShortText -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
lam ShortText
"o" ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
 -> NamesT (TCMT IO) Term)
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall a b. (a -> b) -> a -> b
$ \ NamesT (TCMT IO) Term
_ -> NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
apply_delta_fill NamesT (TCMT IO) Term
i (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
side1 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
-> NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term
hfill NamesT (TCMT IO) Term
lvl NamesT (TCMT IO) Term
htype NamesT (TCMT IO) Term
phi NamesT (TCMT IO) Term
u NamesT (TCMT IO) Term
u0 NamesT (TCMT IO) Term
i))
            let recurse []           NamesT (TCMT IO) Term
i = NamesT (TCMT IO) Term
forall a. HasCallStack => a
__IMPOSSIBLE__
                recurse [(NamesT (TCMT IO) Term
psi,NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
u)]    NamesT (TCMT IO) Term
i = NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
u NamesT (TCMT IO) Term
i
                recurse ((NamesT (TCMT IO) Term
psi,NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
u):[(NamesT (TCMT IO) Term,
  NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)]
xs) NamesT (TCMT IO) Term
i = NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term
pOr_ty NamesT (TCMT IO) Term
i NamesT (TCMT IO) Term
psi (((NamesT (TCMT IO) Term,
  NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
 -> NamesT (TCMT IO) Term -> 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 -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
imax (NamesT (TCMT IO) Term
 -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> ((NamesT (TCMT IO) Term,
     NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
    -> 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 b c a. (b -> c) -> (a -> b) -> a -> c
. (NamesT (TCMT IO) Term,
 NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall a b. (a, b) -> a
fst) (Term -> NamesT (TCMT IO) Term
forall a. a -> NamesT (TCMT IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
iz) [(NamesT (TCMT IO) Term,
  NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)]
xs) (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
u NamesT (TCMT IO) Term
i) ([(NamesT (TCMT IO) Term,
  NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)]
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
recurse [(NamesT (TCMT IO) Term,
  NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)]
xs NamesT (TCMT IO) Term
i)
            return $ recurse sides

        ((,) <$> ty (pure io) <*>) $ comp ty_level
          (lam "i" $ fmap unEl . ty) (phi `imax` alpha)
          (lam "i" $ \ NamesT (TCMT IO) Term
i ->
            let rhs :: NamesT (TCMT IO) Term
rhs = (ShortText
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall (m :: * -> *).
Monad m =>
ShortText -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
lam ShortText
"o" ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
 -> NamesT (TCMT IO) Term)
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall a b. (a -> b) -> a -> b
$ \ NamesT (TCMT IO) Term
o -> NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
call (NamesT (TCMT IO) Term
u NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT (TCMT IO) Term
i NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT (TCMT IO) Term
o) NamesT (TCMT IO) Term
i)
            in if [(Term, (Term, Term))] -> Bool
forall a. Null a => a -> Bool
null [(Term, (Term, Term))]
alphab then NamesT (TCMT IO) Term
rhs else NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term
pOr_ty NamesT (TCMT IO) Term
i NamesT (TCMT IO) Term
phi NamesT (TCMT IO) Term
alpha NamesT (TCMT IO) Term
rhs (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
b NamesT (TCMT IO) Term
i)
          ) (call u0 (pure iz))

    reportSDoc "tc.cover.hcomp" 20 $ text "old_tel =" <+> prettyTCM tel
    let n = Telescope -> Int
forall a. Sized a => a -> Int
size Telescope
tel Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Telescope -> Int
forall a. Sized a => a -> Int
size Telescope
gamma Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Abs Telescope -> Int
forall a. Sized a => a -> Int
size Abs Telescope
delta)
    reportSDoc "tc.cover.hcomp" 20 $ text "n =" <+> text (show n)
    (TelV deltaEx t,bs) <- telViewUpToPathBoundary' n ty
    rhs <- pure $ raise n rhs `applyE` teleElims deltaEx bs

    cxt <- getContextTelescope
    reportSDoc "tc.cover.hcomp" 30 $ text "cxt = " <+> prettyTCM cxt
    reportSDoc "tc.cover.hcomp" 30 $ text "tel = " <+> prettyTCM tel
    reportSDoc "tc.cover.hcomp" 20 $ addContext tel $ text "t = " <+> prettyTCM t
    reportSDoc "tc.cover.hcomp" 20 $ addContext tel $ text "rhs = " <+> prettyTCM rhs

    return $ Clause { clauseLHSRange  = noRange
                    , clauseFullRange = noRange
                    , clauseTel       = tel
                    , namedClausePats = fromSplitPatterns ps
                    , clauseBody      = Just $ rhs
                    , clauseType      = Just $ defaultArg t
                    , clauseCatchall    = empty
                    , clauseRecursive   = MaybeRecursive     -- TODO: can it be recursive?
                    , clauseUnreachable = Just False  -- missing, thus, not unreachable
                    , clauseEllipsis    = NoEllipsis
                    , clauseWhereModule = Nothing
                    }
  addClauses f [cl]  -- Important: add at the end.
  let result = CoverResult
          { coverSplitTree :: SplitTree' SplitTag
coverSplitTree      = Int -> SplitTree' SplitTag
forall a. Int -> SplitTree' a
SplittingDone (Telescope -> Int
forall a. Sized a => a -> Int
size (Clause -> Telescope
clauseTel Clause
cl))
          , coverUsedClauses :: IntSet
coverUsedClauses    = Int -> IntSet
IntSet.singleton ([Clause] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Clause]
cs)
          , coverMissingClauses :: [(Telescope, [NamedArg DeBruijnPattern])]
coverMissingClauses = []
          , coverPatterns :: [Clause]
coverPatterns       = [Clause
cl]
          , coverNoExactClauses :: IntSet
coverNoExactClauses = IntSet
IntSet.empty
          }
  hcompName <- fromMaybe __IMPOSSIBLE__ <$> getName' builtinHComp
  return ([(SplitCon hcompName, result)], cs ++ [cl])
createMissingHCompClause QName
_ Arg Int
_ BlockingVar
_ SplitClause
_ (SClause Telescope
_ [NamedArg SplitPattern]
_ Substitution' SplitPattern
_ Map CheckpointId Substitution
_ Maybe (Dom Type)
Nothing) [Clause]
_ = TCM ([(SplitTag, CoverResult)], [Clause])
forall a. HasCallStack => a
__IMPOSSIBLE__