{-# LANGUAGE NondecreasingIndentation #-}

module Agda.TypeChecking.Coverage.Cubical where

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

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

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

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

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

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

import Agda.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
  reflId <- BuiltinId -> TCMT IO (Maybe QName)
forall (m :: * -> *) a.
(HasBuiltins m, IsBuiltin a) =>
a -> m (Maybe QName)
getName' BuiltinId
builtinReflId
  let infos = [(QName
c,UnifyEquiv
i) | (SplitCon QName
c, (SplitClause
_,TheInfo UnifyEquiv
i)) <- [(SplitTag, (SplitClause, IInfo))]
scs ]
  case scs of
    [(SplitCon QName
c,(SplitClause
_newSc,i :: IInfo
i@TheInfo{}))] | QName -> Maybe QName
forall a. a -> Maybe a
Just QName
c Maybe QName -> Maybe QName -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe QName
reflId -> do
      mc <- QName
-> Arg Int
-> BlockingVar
-> SplitClause
-> IInfo
-> TCM (Maybe ((SplitTag, SplitTree' SplitTag), Clause))
createMissingConIdClause QName
f Arg Int
n BlockingVar
x SplitClause
old_sc IInfo
i
      caseMaybe mc (return ([],cs)) $ \ ((SplitTag
sp,SplitTree' SplitTag
tree),Clause
cl) -> do
      let res :: CoverResult
res = SplitTree' SplitTag
-> IntSet
-> [(Telescope, [NamedArg DeBruijnPattern])]
-> [Clause]
-> IntSet
-> CoverResult
CoverResult SplitTree' SplitTag
tree (Int -> IntSet
IntSet.singleton ([Clause] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Clause]
cs)) [] [Clause
cl] IntSet
IntSet.empty
      ([(SplitTag, CoverResult)], [Clause])
-> TCM ([(SplitTag, CoverResult)], [Clause])
forall a. a -> TCMT IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([(SplitTag
sp,CoverResult
res)],[Clause] -> Clause -> [Clause]
forall a. [a] -> a -> [a]
snoc [Clause]
cs Clause
cl)
    [(SplitTag, (SplitClause, IInfo))]
xs | (QName, UnifyEquiv)
info:[(QName, UnifyEquiv)]
_ <- [(QName, UnifyEquiv)]
infos -> do
         String -> Int -> TCMT IO Doc -> TCMT IO ()
forall (m :: * -> *).
MonadDebug m =>
String -> Int -> TCMT IO Doc -> m ()
reportSDoc String
"tc.cover.indexed" Int
20 (TCMT IO Doc -> TCMT IO ()) -> TCMT IO Doc -> TCMT IO ()
forall a b. (a -> b) -> a -> b
$ String -> TCMT IO Doc
forall (m :: * -> *). Applicative m => String -> m Doc
text String
"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))]
xs,[(QName, UnifyEquiv)] -> Int
forall a. Sized a => a -> Int
size [(QName, UnifyEquiv)]
infos)
         String -> Int -> TCMT IO Doc -> TCMT IO ()
forall (m :: * -> *).
MonadDebug m =>
String -> Int -> TCMT IO Doc -> m ()
reportSDoc String
"tc.cover.indexed" Int
20 (TCMT IO Doc -> TCMT IO ()) -> TCMT IO Doc -> TCMT IO ()
forall a b. (a -> b) -> a -> b
$ String -> TCMT IO Doc
forall (m :: * -> *). Applicative m => String -> m Doc
text String
"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))]
xs)

         Bool -> TCMT IO () -> TCMT IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([(SplitTag, (SplitClause, IInfo))] -> Int
forall a. Sized a => a -> Int
size [(SplitTag, (SplitClause, IInfo))]
xs 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
$
            String -> Int -> TCMT IO Doc -> TCMT IO ()
forall (m :: * -> *).
MonadDebug m =>
String -> Int -> TCMT IO Doc -> m ()
reportSDoc String
"tc.cover.indexed" Int
20 (TCMT IO Doc -> TCMT IO ()) -> TCMT IO Doc -> TCMT IO ()
forall a b. (a -> b) -> a -> b
$ String -> TCMT IO Doc
forall (m :: * -> *). Applicative m => String -> m Doc
text String
"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 => 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)
                                           ]
                 --  = [ (SplitCon trX, SplittingDone $ size $ clauseTel trX_cl) ]
             extraCl = [Clause
trX_cl, Clause
hcomp_cl]
                 --  = [trX_cl]
         let clauses = [Clause]
cls [Clause] -> [Clause] -> [Clause]
forall a. [a] -> [a] -> [a]
++ [Clause]
extraCl
         let 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)
    [(SplitTag, (SplitClause, IInfo))]
xs | Bool
otherwise -> ([(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 -> Closure (Abs Type) -> (Abs Type -> TCM [Term]) -> TCM [Term]
forall (m :: * -> *) c a b.
(MonadTCEnv m, ReadTCState m, LensClosure c a) =>
c -> (a -> m b) -> m b
enterClosure Closure (Abs Type)
failed_t ((Abs Type -> TCM [Term]) -> TCM [Term])
-> (Abs Type -> TCM [Term]) -> TCM [Term]
forall a b. (a -> b) -> a -> b
$ \Abs Type
failed_t -> (String, Dom Type) -> TCM [Term] -> TCM [Term]
forall b (m :: * -> *) a.
(AddContext b, MonadAddContext m) =>
b -> m a -> m a
forall (m :: * -> *) a.
MonadAddContext m =>
(String, Dom Type) -> m a -> m a
addContext (String
"i" :: String, Dom Type
HasCallStack => Dom Type
__DUMMY_DOM__) (TCM [Term] -> TCM [Term]) -> TCM [Term] -> TCM [Term]
forall a b. (a -> b) -> a -> b
$ do
      TypeError -> TCM [Term]
forall (m :: * -> *) a.
(HasCallStack, MonadTCError m) =>
TypeError -> m a
typeError (TypeError -> TCM [Term])
-> (Doc -> TypeError) -> Doc -> TCM [Term]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> TypeError
GenericDocError (Doc -> TCM [Term]) -> TCMT IO Doc -> TCM [Term]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [TCMT IO Doc] -> TCMT IO Doc
forall (m :: * -> *) (t :: * -> *).
(Applicative m, Foldable t) =>
t (m Doc) -> m Doc
vcat
        [ TCMT IO Doc
"Could not generate a transport 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
func
        , TCMT IO Doc
"because a term of type" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> Type -> TCMT IO Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
forall (m :: * -> *). MonadPretty m => Type -> m Doc
prettyTCM (Abs Type -> Type
forall a. Abs a -> a
unAbs Abs Type
failed_t)
        , TCMT IO Doc
"lives in the sort" 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 (Type -> Sort
forall a. LensSort a => a -> Sort
getSort (Abs Type -> Type
forall a. Abs a -> a
unAbs Abs Type
failed_t)) TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> TCMT IO Doc
"and thus can not be transported"
        ]

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

  String -> Int -> TCMT IO Doc -> TCMT IO ()
forall (m :: * -> *).
MonadDebug m =>
String -> Int -> TCMT IO Doc -> m ()
reportSDoc String
"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
  String -> Int -> TCMT IO Doc -> TCMT IO ()
forall (m :: * -> *).
MonadDebug m =>
String -> Int -> TCMT IO Doc -> m ()
reportSDoc String
"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 Term -> TCMT IO Type
forall (m :: * -> *). Functor m => m Term -> m Type
elInf TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primInterval
  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_tel = SplitClause -> Telescope
scTel SplitClause
old_sc
    old_ps' = [String]
-> [NamedArg DeBruijnPattern] -> AbsN [NamedArg DeBruijnPattern]
forall a. [String] -> a -> AbsN a
AbsN (Telescope -> [String]
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
$ [String] -> Dom Type -> AbsN (Dom Type)
forall a. [String] -> a -> AbsN a
AbsN (Telescope -> [String]
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
$ [String] -> Telescope -> AbsN Telescope
forall a. [String] -> a -> AbsN a
AbsN (Telescope -> [String]
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' Term
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' Term
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 String]
teleArgNames Telescope
gamma1
    deltaArgNames = Telescope -> [Arg String]
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 = [String] -> Args -> AbsN Args
forall a. [String] -> a -> AbsN a
AbsN (Telescope -> [String]
teleNames Telescope
gamma1) Args
ps
        xTel = [String] -> Telescope -> AbsN Telescope
forall a. [String] -> a -> AbsN a
AbsN (Telescope -> [String]
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 String]
-> (ArgVars (TCMT IO) -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) (AbsN Type)
forall (m :: * -> *) a.
MonadFail m =>
[Arg String] -> (ArgVars m -> NamesT m a) -> NamesT m (AbsN a)
bindNArg (Telescope -> [Arg String]
teleArgNames (Telescope -> [Arg String]) -> Telescope -> [Arg String]
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 String]
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 String]
-> (ArgVars (TCMT IO)
    -> NamesT (TCMT IO) (AbsN (AbsN DeBruijnPattern)))
-> NamesT (TCMT IO) (AbsN (AbsN (AbsN DeBruijnPattern)))
forall (m :: * -> *) a.
MonadFail m =>
[Arg String] -> (ArgVars m -> NamesT m a) -> NamesT m (AbsN a)
bindNArg [Arg String]
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 String]
-> (ArgVars (TCMT IO) -> NamesT (TCMT IO) (AbsN DeBruijnPattern))
-> NamesT (TCMT IO) (AbsN (AbsN DeBruijnPattern))
forall (m :: * -> *) a.
MonadFail m =>
[Arg String] -> (ArgVars m -> NamesT m a) -> NamesT m (AbsN a)
bindNArg ([String -> Arg String
forall e. e -> Arg e
defaultArg String
"phi"] [Arg String] -> [Arg String] -> [Arg String]
forall a. [a] -> [a] -> [a]
++ [Arg String]
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 String]
-> (ArgVars (TCMT IO) -> NamesT (TCMT IO) DeBruijnPattern)
-> NamesT (TCMT IO) (AbsN DeBruijnPattern)
forall (m :: * -> *) a.
MonadFail m =>
[Arg String] -> (ArgVars m -> NamesT m a) -> NamesT m (AbsN a)
bindNArg [String -> Arg String
forall e. e -> Arg e
defaultArg String
"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) <- 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' =
            [String]
-> (Vars (TCMT IO)
    -> NamesT (TCMT IO) (AbsN (AbsN (AbsN DeBruijnPattern))))
-> NamesT (TCMT IO) (AbsN (AbsN (AbsN (AbsN DeBruijnPattern))))
forall (m :: * -> *) a.
MonadFail m =>
[String] -> (Vars m -> NamesT m a) -> NamesT m (AbsN a)
bindN ((Arg String -> String) -> [Arg String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Arg String -> String
forall e. Arg e -> e
unArg [Arg String]
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
            [String]
-> (Vars (TCMT IO)
    -> NamesT (TCMT IO) (AbsN (AbsN DeBruijnPattern)))
-> NamesT (TCMT IO) (AbsN (AbsN (AbsN DeBruijnPattern)))
forall (m :: * -> *) a.
MonadFail m =>
[String] -> (Vars m -> NamesT m a) -> NamesT m (AbsN a)
bindN ((Arg String -> String) -> [Arg String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Arg String -> String
forall e. Arg e -> e
unArg ([Arg String] -> [String]) -> [Arg String] -> [String]
forall a b. (a -> b) -> a -> b
$ ([String -> Arg String
forall e. e -> Arg e
defaultArg String
"phi"] [Arg String] -> [Arg String] -> [Arg String]
forall a. [a] -> [a] -> [a]
++ [Arg String]
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
            [String]
-> (Vars (TCMT IO) -> NamesT (TCMT IO) (AbsN DeBruijnPattern))
-> NamesT (TCMT IO) (AbsN (AbsN DeBruijnPattern))
forall (m :: * -> *) a.
MonadFail m =>
[String] -> (Vars m -> NamesT m a) -> NamesT m (AbsN a)
bindN ((Arg String -> String) -> [Arg String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Arg String -> String
forall e. Arg e -> e
unArg ([Arg String] -> [String]) -> [Arg String] -> [String]
forall a b. (a -> b) -> a -> b
$ ([String -> Arg String
forall e. e -> Arg e
defaultArg String
"psi"] [Arg String] -> [Arg String] -> [Arg String]
forall a. [a] -> [a] -> [a]
++ [Arg String]
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
            [String]
-> (Vars (TCMT IO) -> NamesT (TCMT IO) DeBruijnPattern)
-> NamesT (TCMT IO) (AbsN DeBruijnPattern)
forall (m :: * -> *) a.
MonadFail m =>
[String] -> (Vars m -> NamesT m a) -> NamesT m (AbsN a)
bindN ((Arg String -> String) -> [Arg String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Arg String -> String
forall e. Arg e -> e
unArg ([Arg String] -> [String]) -> [Arg String] -> [String]
forall a b. (a -> b) -> a -> b
$ [String -> Arg String
forall e. e -> Arg e
defaultArg String
"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
    String
-> NamesT (TCMT IO) Type
-> (Var (TCMT IO) -> NamesT (TCMT IO) Telescope)
-> NamesT (TCMT IO) Telescope
forall (m :: * -> *) a.
(MonadFail m, Abstract a) =>
String -> NamesT m Type -> (Var m -> NamesT m a) -> NamesT m a
abstractT String
"φ" (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.
(MonadFail 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
    String
-> NamesT (TCMT IO) Type
-> (Var (TCMT IO) -> NamesT (TCMT IO) Telescope)
-> NamesT (TCMT IO) Telescope
forall (m :: * -> *) a.
(MonadFail m, Abstract a) =>
String -> NamesT m Type -> (Var m -> NamesT m a) -> NamesT m a
abstractT String
"ψ" (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.
(MonadFail 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
    String
-> NamesT (TCMT IO) Type
-> (Var (TCMT IO) -> NamesT (TCMT IO) Telescope)
-> NamesT (TCMT IO) Telescope
forall (m :: * -> *) a.
(MonadFail m, Abstract a) =>
String -> NamesT m Type -> (Var m -> NamesT m a) -> NamesT m a
abstractT String
"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]
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> [NamesT (TCMT IO) Term]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
for [NamesT (TCMT IO) Term]
Vars (TCMT IO)
q (\ 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
    String
-> (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.
MonadFail m =>
String
-> ((forall b. (Subst b, DeBruijn b) => NamesT m b) -> NamesT m a)
-> NamesT m (Abs a)
bind String
"φ" ((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
    [String]
-> (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.
MonadFail m =>
[String] -> (Vars m -> NamesT m a) -> NamesT m (AbsN a)
bindN ((Arg String -> String) -> [Arg String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Arg String -> String
forall e. Arg e -> e
unArg [Arg String]
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
    String
-> (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.
MonadFail m =>
String
-> ((forall b. (Subst b, DeBruijn b) => NamesT m b) -> NamesT m a)
-> NamesT m (Abs a)
bind String
"ψ" ((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
    [String]
-> (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.
MonadFail m =>
[String] -> (Vars m -> NamesT m a) -> NamesT m (AbsN a)
bindN ((Arg String -> String) -> [Arg String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Arg String -> String
forall e. Arg e -> e
unArg [Arg String]
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
    String
-> (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.
MonadFail m =>
String
-> ((forall b. (Subst b, DeBruijn b) => NamesT m b) -> NamesT m a)
-> NamesT m (Abs a)
bind String
"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
    [String]
-> (Vars (TCMT IO)
    -> NamesT (TCMT IO) ([NamedArg DeBruijnPattern], Dom Type, Term))
-> NamesT
     (TCMT IO) (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term))
forall (m :: * -> *) a.
MonadFail m =>
[String] -> (Vars m -> NamesT m a) -> NamesT m (AbsN a)
bindN ((Arg String -> String) -> [Arg String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Arg String -> String
forall e. Arg e -> e
unArg [Arg String]
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.
(MonadFail 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
$ String
-> (Var (TCMT IO) -> NamesT (TCMT IO) [Term])
-> NamesT (TCMT IO) (Abs [Term])
forall (m :: * -> *) a.
MonadFail m =>
String
-> ((forall b. (Subst b, DeBruijn b) => NamesT m b) -> NamesT m a)
-> NamesT m (Abs a)
bind String
"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 <- String
-> (Var (TCMT IO) -> NamesT (TCMT IO) Telescope)
-> NamesT (TCMT IO) (Abs Telescope)
forall (m :: * -> *) a.
MonadFail m =>
String
-> ((forall b. (Subst b, DeBruijn b) => NamesT m b) -> NamesT m a)
-> NamesT m (Abs a)
bind String
"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))
      Right xs <- 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.
(MonadFail m, Subst a) =>
a -> NamesT m (NamesT m a)
open ([Term] -> NamesT (TCMT IO) [NamesT (TCMT IO) Term])
-> NamesT (TCMT IO) [Term]
-> NamesT (TCMT IO) [NamesT (TCMT IO) Term]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (NamesT (TCMT IO) [Term]
 -> NamesT (TCMT IO) [NamesT (TCMT IO) Term])
-> NamesT (TCMT IO) [Term]
-> NamesT (TCMT IO) [NamesT (TCMT IO) Term]
forall a b. (a -> b) -> a -> b
$ NamesT (TCMT IO) (Abs [Term]) -> NamesT (TCMT IO) [Term]
forall (m :: * -> *).
Monad m =>
NamesT m (Abs [Term]) -> NamesT m [Term]
lamTel (NamesT (TCMT IO) (Abs [Term]) -> NamesT (TCMT IO) [Term])
-> NamesT (TCMT IO) (Abs [Term]) -> NamesT (TCMT IO) [Term]
forall a b. (a -> b) -> a -> b
$ String
-> (Var (TCMT IO) -> NamesT (TCMT IO) [Term])
-> NamesT (TCMT IO) (Abs [Term])
forall (m :: * -> *) a.
MonadFail m =>
String
-> ((forall b. (Subst b, DeBruijn b) => NamesT m b) -> NamesT m a)
-> NamesT m (Abs a)
bind String
"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.
(MonadFail 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
                  String
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
lam String
"j" ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
 -> NamesT (TCMT IO) Term)
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall a b. (a -> b) -> a -> b
$ \ NamesT (TCMT IO) Term
j -> String
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
ilam String
"o" ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
 -> NamesT (TCMT IO) Term)
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall a b. (a -> b) -> a -> b
$ \ NamesT (TCMT IO) Term
_ -> do
                    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.
(MonadFail 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.
(MonadFail m, Subst a) =>
a -> NamesT m (NamesT m a)
open Term
phi) (Term -> NamesT (TCMT IO) (NamesT (TCMT IO) Term)
forall (m :: * -> *) a.
(MonadFail m, Subst a) =>
a -> NamesT m (NamesT m a)
open Term
u)
    let mkComp NamesT (TCMT IO) (AbsN Term)
pr = String
-> (Var (TCMT IO) -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) (Abs Term)
forall (m :: * -> *) a.
MonadFail m =>
String
-> ((forall b. (Subst b, DeBruijn b) => NamesT m b) -> NamesT m a)
-> NamesT m (Abs a)
bind String
"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.
(MonadFail 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
$ String
-> (Var (TCMT IO) -> NamesT (TCMT IO) [Term])
-> NamesT (TCMT IO) (Abs [Term])
forall (m :: * -> *) a.
MonadFail m =>
String
-> ((forall b. (Subst b, DeBruijn b) => NamesT m b) -> NamesT m a)
-> NamesT m (Abs a)
bind String
"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 <- String
-> (Var (TCMT IO) -> NamesT (TCMT IO) Telescope)
-> NamesT (TCMT IO) (Abs Telescope)
forall (m :: * -> *) a.
MonadFail m =>
String
-> ((forall b. (Subst b, DeBruijn b) => NamesT m b) -> NamesT m a)
-> NamesT m (Abs a)
bind String
"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 = String
-> (Var (TCMT IO) -> NamesT (TCMT IO) [Term])
-> NamesT (TCMT IO) (Abs [Term])
forall (m :: * -> *) a.
MonadFail m =>
String
-> ((forall b. (Subst b, DeBruijn b) => NamesT m b) -> NamesT m a)
-> NamesT m (Abs a)
bind String
"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.
(MonadFail 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 -> String
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
ilam String
"o" ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
 -> NamesT (TCMT IO) Term)
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall a b. (a -> b) -> a -> b
$ \ NamesT (TCMT IO) Term
_ -> do
      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
$ [String]
-> (Vars (TCMT IO) -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) (AbsN Term)
forall (m :: * -> *) a.
MonadFail m =>
[String] -> (Vars m -> NamesT m a) -> NamesT m (AbsN a)
bindN [String
"i",String
"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
        Abs n (data_ty,lines) <- String
-> (Var (TCMT IO) -> NamesT (TCMT IO) (Type, [Term]))
-> NamesT (TCMT IO) (Abs (Type, [Term]))
forall (m :: * -> *) a.
MonadFail m =>
String
-> ((forall b. (Subst b, DeBruijn b) => NamesT m b) -> NamesT m a)
-> NamesT m (Abs a)
bind String
"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]
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> [NamesT (TCMT IO) Term]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
for [NamesT (TCMT IO) Term]
Vars (TCMT IO)
p ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
 -> [NamesT (TCMT IO) Term])
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> [NamesT (TCMT IO) Term]
forall a b. (a -> b) -> a -> b
$ \ NamesT (TCMT IO) Term
p -> String
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
lam String
"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]
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> [NamesT (TCMT IO) Term]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
for [NamesT (TCMT IO) Term]
Vars (TCMT IO)
p (\ 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      : for p_k (\ NamesT (TCMT IO) Term
p -> String
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
lam String
"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): for p_k (\ NamesT (TCMT IO) Term
p -> String
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
lam String
"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])
        data_ty <- open $ Abs n data_ty
        [line1,line2] <- mapM (open . Abs n) lines
        let sys = [(NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
neg NamesT (TCMT IO) Term
i, String
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
lam String
"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 -> String
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
ilam String
"o" ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
 -> NamesT (TCMT IO) Term)
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall a b. (a -> b) -> a -> b
$ \ NamesT (TCMT IO) Term
_ -> 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, String
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
lam String
"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 -> String
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
ilam String
"o" ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
 -> NamesT (TCMT IO) Term)
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall a b. (a -> b) -> a -> b
$ \ NamesT (TCMT IO) Term
_ -> 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
      absApp <$> pure c <*> i
    sysphi <- (open =<<) $ lam "i" $ \ NamesT (TCMT IO) Term
i -> String
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
ilam String
"o" ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
 -> NamesT (TCMT IO) Term)
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall a b. (a -> b) -> a -> b
$ \ NamesT (TCMT IO) Term
o -> do
      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
$ [String]
-> (Vars (TCMT IO) -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) (AbsN Term)
forall (m :: * -> *) a.
MonadFail m =>
[String] -> (Vars m -> NamesT m a) -> NamesT m (AbsN a)
bindN [String
"i",String
"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 ([String]
-> (Vars (TCMT IO) -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) (AbsN Term)
forall (m :: * -> *) a.
MonadFail m =>
[String] -> (Vars m -> NamesT m a) -> NamesT m (AbsN a)
bindN [String
"i",String
"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
    let rhs = NamesT (TCMT IO) Type
-> [(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,
 MonadPretty m) =>
NamesT m Type
-> [(NamesT m Term, NamesT m Term)]
-> NamesT m Term
-> NamesT m Term
hcomp (Dom Type -> Type
forall t e. Dom' t e -> e
unDom (Dom Type -> Type)
-> NamesT (TCMT IO) (Dom Type) -> NamesT (TCMT IO) Type
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamesT (TCMT IO) (Dom Type)
rhsTy) [(NamesT (TCMT IO) Term, NamesT (TCMT IO) Term)]
sys NamesT (TCMT IO) Term
w0
    (,,) <$> ps <*> rhsTy <*> 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 :: Bool
clauseCatchall    = Bool
False
                 , clauseExact :: Maybe Bool
clauseExact       = Maybe Bool
forall a. Maybe a
Nothing
                 , clauseRecursive :: Maybe Bool
clauseRecursive   = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True
                 , 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

  String -> Int -> TCMT IO Doc -> TCMT IO ()
forall (m :: * -> *).
MonadDebug m =>
String -> Int -> TCMT IO Doc -> m ()
reportSDoc String
"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
  String -> Int -> TCMT IO Doc -> TCMT IO ()
forall (m :: * -> *).
MonadDebug m =>
String -> Int -> TCMT IO Doc -> m ()
reportSDoc String
"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
  let
   old_tel = SplitClause -> Telescope
scTel SplitClause
old_sc
   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 -> 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

  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 <- elInf primInterval
  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_tel = SplitClause -> Telescope
scTel SplitClause
old_sc
    old_ps' = [String]
-> [NamedArg DeBruijnPattern] -> AbsN [NamedArg DeBruijnPattern]
forall a. [String] -> a -> AbsN a
AbsN (Telescope -> [String]
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
$ [String] -> Dom Type -> AbsN (Dom Type)
forall a. [String] -> a -> AbsN a
AbsN (Telescope -> [String]
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
$ [String] -> Telescope -> AbsN Telescope
forall a. [String] -> a -> AbsN a
AbsN (Telescope -> [String]
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' Term
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' Term
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 String]
teleArgNames Telescope
gamma1
    deltaArgNames = Telescope -> [Arg String]
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 = [String] -> Args -> AbsN Args
forall a. [String] -> a -> AbsN a
AbsN (Telescope -> [String]
teleNames Telescope
gamma1) Args
ps
        xTel = [String] -> Telescope -> AbsN Telescope
forall a. [String] -> a -> AbsN a
AbsN (Telescope -> [String]
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 String]
-> (ArgVars (TCMT IO) -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) (AbsN Type)
forall (m :: * -> *) a.
MonadFail m =>
[Arg String] -> (ArgVars m -> NamesT m a) -> NamesT m (AbsN a)
bindNArg (Telescope -> [Arg String]
teleArgNames (Telescope -> [Arg String]) -> Telescope -> [Arg String]
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 String]
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 String]
-> (ArgVars (TCMT IO)
    -> NamesT (TCMT IO) (AbsN (AbsN DeBruijnPattern)))
-> NamesT (TCMT IO) (AbsN (AbsN (AbsN DeBruijnPattern)))
forall (m :: * -> *) a.
MonadFail m =>
[Arg String] -> (ArgVars m -> NamesT m a) -> NamesT m (AbsN a)
bindNArg [Arg String]
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 String]
-> (ArgVars (TCMT IO) -> NamesT (TCMT IO) (AbsN DeBruijnPattern))
-> NamesT (TCMT IO) (AbsN (AbsN DeBruijnPattern))
forall (m :: * -> *) a.
MonadFail m =>
[Arg String] -> (ArgVars m -> NamesT m a) -> NamesT m (AbsN a)
bindNArg ([String -> Arg String
forall e. e -> Arg e
defaultArg String
"phi"] [Arg String] -> [Arg String] -> [Arg String]
forall a. [a] -> [a] -> [a]
++ [Arg String]
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 String]
-> (ArgVars (TCMT IO) -> NamesT (TCMT IO) DeBruijnPattern)
-> NamesT (TCMT IO) (AbsN DeBruijnPattern)
forall (m :: * -> *) a.
MonadFail m =>
[Arg String] -> (ArgVars m -> NamesT m a) -> NamesT m (AbsN a)
bindNArg [String -> Arg String
forall e. e -> Arg e
defaultArg String
"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) <- 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 String]
-> (ArgVars (TCMT IO) -> NamesT (TCMT IO) DeBruijnPattern)
-> NamesT (TCMT IO) (AbsN DeBruijnPattern)
forall (m :: * -> *) a.
MonadFail m =>
[Arg String] -> (ArgVars m -> NamesT m a) -> NamesT m (AbsN a)
bindNArg [String -> Arg String
forall e. e -> Arg e
argH String
"psi",String -> Arg String
forall e. e -> Arg e
argN String
"u", String -> Arg String
forall e. e -> Arg e
argN String
"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
        Just (LEl l t) <- (toLType =<<) $ 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
            [String]
-> (Vars (TCMT IO) -> NamesT (TCMT IO) (AbsN Term))
-> NamesT (TCMT IO) (AbsN (AbsN Term))
forall (m :: * -> *) a.
MonadFail m =>
[String] -> (Vars m -> NamesT m a) -> NamesT m (AbsN a)
bindN (Telescope -> [String]
teleNames (Telescope -> [String]) -> Telescope -> [String]
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' =
            [String]
-> (Vars (TCMT IO)
    -> NamesT (TCMT IO) (AbsN (AbsN DeBruijnPattern)))
-> NamesT (TCMT IO) (AbsN (AbsN (AbsN DeBruijnPattern)))
forall (m :: * -> *) a.
MonadFail m =>
[String] -> (Vars m -> NamesT m a) -> NamesT m (AbsN a)
bindN ((Arg String -> String) -> [Arg String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Arg String -> String
forall e. Arg e -> e
unArg [Arg String]
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 String
-> (Vars1 (TCMT IO) -> NamesT (TCMT IO) (AbsN DeBruijnPattern))
-> NamesT (TCMT IO) (AbsN (AbsN DeBruijnPattern))
forall (m :: * -> *) a.
MonadFail m =>
List1 String -> (Vars1 m -> NamesT m a) -> NamesT m (AbsN a)
bindN1 ((Arg String -> String) -> NonEmpty (Arg String) -> List1 String
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Arg String -> String
forall e. Arg e -> e
unArg (String -> Arg String
forall e. e -> Arg e
defaultArg String
"phi" Arg String -> [Arg String] -> NonEmpty (Arg String)
forall a. a -> [a] -> NonEmpty a
:| [Arg String]
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
            [String]
-> (Vars (TCMT IO) -> NamesT (TCMT IO) DeBruijnPattern)
-> NamesT (TCMT IO) (AbsN DeBruijnPattern)
forall (m :: * -> *) a.
MonadFail m =>
[String] -> (Vars m -> NamesT m a) -> NamesT m (AbsN a)
bindN [String
"psi",String
"u",String
"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 = [NamesT (TCMT IO) Term]
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> [NamesT (TCMT IO) Term]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
for (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 -> NamesT (TCMT IO) Term)
-> [NamesT (TCMT IO) Term]
forall a b. (a -> b) -> a -> 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
    String
-> NamesT (TCMT IO) Type
-> (Var (TCMT IO) -> NamesT (TCMT IO) Telescope)
-> NamesT (TCMT IO) Telescope
forall (m :: * -> *) a.
(MonadFail m, Abstract a) =>
String -> NamesT m Type -> (Var m -> NamesT m a) -> NamesT m a
abstractT String
"φ" (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.
(MonadFail 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]
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> [NamesT (TCMT IO) Term]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
for [NamesT (TCMT IO) Term]
Vars (TCMT IO)
p ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
 -> [NamesT (TCMT IO) Term])
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> [NamesT (TCMT IO) Term]
forall a b. (a -> b) -> a -> b
$ \ NamesT (TCMT IO) Term
p -> 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
    String
-> NamesT (TCMT IO) Type
-> (Var (TCMT IO) -> NamesT (TCMT IO) Telescope)
-> NamesT (TCMT IO) Telescope
forall (m :: * -> *) a.
(MonadFail m, Abstract a) =>
String -> NamesT m Type -> (Var m -> NamesT m a) -> NamesT m a
abstractT String
"ψ" (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
    String
-> NamesT (TCMT IO) Type
-> (Var (TCMT IO) -> NamesT (TCMT IO) Telescope)
-> NamesT (TCMT IO) Telescope
forall (m :: * -> *) a.
(MonadFail m, Abstract a) =>
String -> NamesT m Type -> (Var m -> NamesT m a) -> NamesT m a
abstractT String
"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 :: * -> *). Applicative m => m Type -> m Type -> m Type
--> String
-> NamesT (TCMT IO) Term
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall (m :: * -> *).
(MonadAddContext m, HasBuiltins m, MonadDebug m) =>
String
-> NamesT m Term
-> (NamesT m Term -> NamesT m Type)
-> NamesT m Type
pPi' String
"o" NamesT (TCMT IO) Term
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
    String
-> NamesT (TCMT IO) Type
-> (Var (TCMT IO) -> NamesT (TCMT IO) Telescope)
-> NamesT (TCMT IO) Telescope
forall (m :: * -> *) a.
(MonadFail m, Abstract a) =>
String -> NamesT m Type -> (Var m -> NamesT m a) -> NamesT m a
abstractT String
"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
    String
-> (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.
MonadFail m =>
String
-> ((forall b. (Subst b, DeBruijn b) => NamesT m b) -> NamesT m a)
-> NamesT m (Abs a)
bind String
"φ" ((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
    [String]
-> (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.
MonadFail m =>
[String] -> (Vars m -> NamesT m a) -> NamesT m (AbsN a)
bindN ((Arg String -> String) -> [Arg String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Arg String -> String
forall e. Arg e -> e
unArg [Arg String]
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
    String
-> (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.
MonadFail m =>
String
-> ((forall b. (Subst b, DeBruijn b) => NamesT m b) -> NamesT m a)
-> NamesT m (Abs a)
bind String
"ψ" ((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
    String
-> (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.
MonadFail m =>
String
-> ((forall b. (Subst b, DeBruijn b) => NamesT m b) -> NamesT m a)
-> NamesT m (Abs a)
bind String
"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
    String
-> (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.
MonadFail m =>
String
-> ((forall b. (Subst b, DeBruijn b) => NamesT m b) -> NamesT m a)
-> NamesT m (Abs a)
bind String
"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
    [String]
-> (Vars (TCMT IO)
    -> NamesT (TCMT IO) ([NamedArg DeBruijnPattern], Dom Type, Term))
-> NamesT
     (TCMT IO) (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term))
forall (m :: * -> *) a.
MonadFail m =>
[String] -> (Vars m -> NamesT m a) -> NamesT m (AbsN a)
bindN ((Arg String -> String) -> [Arg String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Arg String -> String
forall e. Arg e -> e
unArg [Arg String]
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.
(MonadFail 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]
          let p0 :: [NamesT (TCMT IO) Term]
p0 = [NamesT (TCMT IO) Term]
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> [NamesT (TCMT IO) Term]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
for [NamesT (TCMT IO) Term]
Vars (TCMT IO)
p ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
 -> [NamesT (TCMT IO) Term])
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> [NamesT (TCMT IO) Term]
forall a b. (a -> b) -> a -> b
$ \ NamesT (TCMT IO) Term
p -> 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) Term -> NamesT (TCMT IO) Term
tr (NamesT (TCMT IO) Type
-> [(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,
 MonadPretty m) =>
NamesT m Type
-> [(NamesT m Term, NamesT m Term)]
-> NamesT m Term
-> NamesT m 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,String
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
lam String
"j" ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
 -> NamesT (TCMT IO) Term)
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall a b. (a -> b) -> a -> b
$ \ NamesT (TCMT IO) Term
j -> NamesT (TCMT IO) Term
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  ,String
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
lam String
"j" ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
 -> NamesT (TCMT IO) Term)
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall a b. (a -> b) -> a -> b
$ \ NamesT (TCMT IO) Term
_ -> String
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
ilam String
"o" ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
 -> NamesT (TCMT IO) Term)
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall a b. (a -> b) -> a -> b
$ \ NamesT (TCMT IO) Term
_ -> NamesT (TCMT IO) Term
Var (TCMT IO)
u0)]
                    NamesT (TCMT IO) Term
Var (TCMT IO)
u0)
    --   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.
(MonadFail 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
                  String
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
lam String
"j" ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
 -> NamesT (TCMT IO) Term)
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall a b. (a -> b) -> a -> b
$ \ NamesT (TCMT IO) Term
j -> String
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
ilam String
"o" ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
 -> NamesT (TCMT IO) Term)
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall a b. (a -> b) -> a -> b
$ \ NamesT (TCMT IO) Term
_ -> do
                    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.
(MonadFail 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.
(MonadFail m, Subst a) =>
a -> NamesT m (NamesT m a)
open Term
phi) (Term -> NamesT (TCMT IO) (NamesT (TCMT IO) Term)
forall (m :: * -> *) a.
(MonadFail 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 <- String
-> (Var (TCMT IO) -> NamesT (TCMT IO) Telescope)
-> NamesT (TCMT IO) (Abs Telescope)
forall (m :: * -> *) a.
MonadFail m =>
String
-> ((forall b. (Subst b, DeBruijn b) => NamesT m b) -> NamesT m a)
-> NamesT m (Abs a)
bind String
"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 = String
-> (Var (TCMT IO) -> NamesT (TCMT IO) [Term])
-> NamesT (TCMT IO) (Abs [Term])
forall (m :: * -> *) a.
MonadFail m =>
String
-> ((forall b. (Subst b, DeBruijn b) => NamesT m b) -> NamesT m a)
-> NamesT m (Abs a)
bind String
"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.
(MonadFail 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 -> String
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
ilam String
"o" ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
 -> NamesT (TCMT IO) Term)
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall a b. (a -> b) -> a -> b
$ \ NamesT (TCMT IO) Term
_ -> do
        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.
(MonadFail 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 :: Bool
clauseCatchall    = Bool
False
                 , clauseExact :: Maybe Bool
clauseExact       = Maybe Bool
forall a. Maybe a
Nothing
                 , clauseRecursive :: Maybe Bool
clauseRecursive   = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True
                 , 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' Term
tau Substitution' Term
leftInv) = do
  String -> Int -> TCMT IO Doc -> TCMT IO ()
forall (m :: * -> *).
MonadDebug m =>
String -> Int -> TCMT IO Doc -> m ()
reportSDoc String
"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
  String -> Int -> TCMT IO Doc -> TCMT IO ()
forall (m :: * -> *).
MonadDebug m =>
String -> Int -> TCMT IO Doc -> m ()
reportSDoc String
"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)
    ]

  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 => 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 <- elInf primInterval
  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
$ [String]
-> [NamedArg DeBruijnPattern] -> AbsN [NamedArg DeBruijnPattern]
forall a. [String] -> a -> AbsN a
AbsN (Telescope -> [String]
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
$ [String] -> Dom Type -> AbsN (Dom Type)
forall a. [String] -> a -> AbsN a
AbsN (Telescope -> [String]
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
  let
    gammaArgNames = Telescope -> [Arg String]
teleArgNames Telescope
gamma
    deltaArgNames = Telescope -> [Arg String]
teleArgNames Telescope
delta'
  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
$ [String] -> Telescope -> AbsN Telescope
forall a. [String] -> a -> AbsN a
AbsN (Telescope -> [String]
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
$ [String] -> Telescope -> AbsN Telescope
forall a. [String] -> a -> AbsN a
AbsN (Telescope -> [String]
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 String]
-> (ArgVars (TCMT IO) -> NamesT (TCMT IO) (AbsN DeBruijnPattern))
-> NamesT (TCMT IO) (AbsN (AbsN DeBruijnPattern))
forall (m :: * -> *) a.
MonadFail m =>
[Arg String] -> (ArgVars m -> NamesT m a) -> NamesT m (AbsN a)
bindNArg [Arg String]
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 String]
-> (ArgVars (TCMT IO) -> NamesT (TCMT IO) DeBruijnPattern)
-> NamesT (TCMT IO) (AbsN DeBruijnPattern)
forall (m :: * -> *) a.
MonadFail m =>
[Arg String] -> (ArgVars m -> NamesT m a) -> NamesT m (AbsN a)
bindNArg ([String -> Arg String
forall e. e -> Arg e
defaultArg String
"phi"] [Arg String] -> [Arg String] -> [Arg String]
forall a. [a] -> [a] -> [a]
++ Telescope -> [Arg String]
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) <- [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
            -- Amy (2022-11-06): Set the parameters to quantity-0.
            param_args <- fmap (map (setQuantity (Quantity0 Q0Inferred) . 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) (String -> Term -> Abs Term
forall a. String -> a -> Abs a
Abs String
"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' Term
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' = [String]
-> (Vars (TCMT IO) -> NamesT (TCMT IO) (AbsN (Abs [Term])))
-> NamesT (TCMT IO) (AbsN (AbsN (Abs [Term])))
forall (m :: * -> *) a.
MonadFail m =>
[String] -> (Vars m -> NamesT m a) -> NamesT m (AbsN a)
bindN ((Arg String -> String) -> [Arg String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Arg String -> String
forall e. Arg e -> e
unArg [Arg String]
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
                [String]
-> (Vars (TCMT IO) -> NamesT (TCMT IO) (Abs [Term]))
-> NamesT (TCMT IO) (AbsN (Abs [Term]))
forall (m :: * -> *) a.
MonadFail m =>
[String] -> (Vars m -> NamesT m a) -> NamesT m (AbsN a)
bindN ((Arg String -> String) -> [Arg String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Arg String -> String
forall e. Arg e -> e
unArg ([Arg String] -> [String]) -> [Arg String] -> [String]
forall a b. (a -> b) -> a -> b
$ [String -> Arg String
forall e. e -> Arg e
defaultArg String
"phi"] [Arg String] -> [Arg String] -> [Arg String]
forall a. [a] -> [a] -> [a]
++ Telescope -> [Arg String]
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
    String
-> NamesT (TCMT IO) Type
-> (Var (TCMT IO) -> NamesT (TCMT IO) Telescope)
-> NamesT (TCMT IO) Telescope
forall (m :: * -> *) a.
(MonadFail m, Abstract a) =>
String -> NamesT m Type -> (Var m -> NamesT m a) -> NamesT m a
abstractT String
"φ" (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.
(MonadFail 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
    String
-> (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.
MonadFail m =>
String
-> ((forall b. (Subst b, DeBruijn b) => NamesT m b) -> NamesT m a)
-> NamesT m (Abs a)
bind String
"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
    [String]
-> (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.
MonadFail m =>
[String] -> (Vars m -> NamesT m a) -> NamesT m (AbsN a)
bindN (Telescope -> [String]
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
    [String]
-> (Vars (TCMT IO)
    -> NamesT (TCMT IO) ([NamedArg DeBruijnPattern], Dom Type, Term))
-> NamesT
     (TCMT IO) (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term))
forall (m :: * -> *) a.
MonadFail m =>
[String] -> (Vars m -> NamesT m a) -> NamesT m (AbsN a)
bindN ((Arg String -> String) -> [Arg String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Arg String -> String
forall e. Arg e -> e
unArg ([Arg String] -> [String]) -> [Arg String] -> [String]
forall a b. (a -> b) -> a -> b
$ [Arg String]
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.
(MonadFail 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
$ String
-> (Var (TCMT IO) -> NamesT (TCMT IO) Telescope)
-> NamesT (TCMT IO) (Abs Telescope)
forall (m :: * -> *) a.
MonadFail m =>
String
-> ((forall b. (Subst b, DeBruijn b) => NamesT m b) -> NamesT m a)
-> NamesT m (Abs a)
bind String
"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.
(MonadFail 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.
(MonadFail 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.
(MonadFail 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' Term
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' Term
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.
(MonadFail m, Subst a) =>
a -> NamesT m (NamesT m a)
open Abs Term
u'
        u <- lam "i" $ \ NamesT (TCMT IO) Term
i -> String
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
ilam String
"o" ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
 -> NamesT (TCMT IO) Term)
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall a b. (a -> b) -> a -> b
$ \ NamesT (TCMT IO) Term
o -> 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 :: Bool
clauseCatchall    = Bool
False
                  , clauseExact :: Maybe Bool
clauseExact       = Maybe Bool
forall a. Maybe a
Nothing
                  , clauseRecursive :: Maybe Bool
clauseRecursive   = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True
                  , 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
    ]

  let mod =
        Relevance -> Modality -> Modality
forall a. LensRelevance a => Relevance -> a -> a
setRelevance Relevance
Irrelevant (Modality -> Modality) -> Modality -> Modality
forall a b. (a -> b) -> a -> b
$  -- See #5611.
        Dom Type -> Modality
forall a. LensModality a => a -> Modality
getModality (Dom Type -> Modality) -> Dom Type -> Modality
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
  -- we follow what `cover` does when updating the modality from the target.
  applyModalityToContext mod $ do
    unlessM (hasQuantity0 <$> viewTC eQuantity) $ do
    reportSDoc "tc.cover.trxcon" 20 $ text "testing usable at mod: " <+> pretty mod
    addContext cTel $ usableAtModality IndexedClause mod rhs

  return cl

-- | If given @TheInfo{}@ then assumes "x : Id u v" and
--   returns both a @SplittingDone@ for conId, and the @Clause@ that covers it.
createMissingConIdClause :: QName         -- ^ function being defined
                         -> Arg Nat       -- ^ @covSplitArg@ index
                         -> BlockingVar   -- ^ @x@ variable being split on.
                         -> SplitClause   -- ^ clause before split
                         -> IInfo         -- ^ info from unification
                         -> TCM (Maybe ((SplitTag,SplitTree),Clause))
createMissingConIdClause :: QName
-> Arg Int
-> BlockingVar
-> SplitClause
-> IInfo
-> TCM (Maybe ((SplitTag, SplitTree' SplitTag), Clause))
createMissingConIdClause QName
f Arg Int
_n BlockingVar
x SplitClause
old_sc (TheInfo UnifyEquiv
info) = QName
-> TCM (Maybe ((SplitTag, SplitTree' SplitTag), Clause))
-> TCM (Maybe ((SplitTag, SplitTree' SplitTag), Clause))
forall (m :: * -> *) x a.
(MonadTrace m, HasRange x) =>
x -> m a -> m a
setCurrentRange QName
f (TCM (Maybe ((SplitTag, SplitTree' SplitTag), Clause))
 -> TCM (Maybe ((SplitTag, SplitTree' SplitTag), Clause)))
-> TCM (Maybe ((SplitTag, SplitTree' SplitTag), Clause))
-> TCM (Maybe ((SplitTag, SplitTree' SplitTag), Clause))
forall a b. (a -> b) -> a -> b
$ do
  let
    -- iΓ'
    itel :: UnifyEquiv -> Telescope
itel = UnifyEquiv -> Telescope
infoTel
    -- with 3 params, reflId : Id A u u -- no arguments.
    -- iΓ' ⊢ iρ : Γ
    --
    -- Δ = Γ,φ,(p : u ≡ v) ⊢ iτ : iΓ'
    -- ρ = iρ
    -- τ = iτ
    irho :: PatternSubstitution
irho = UnifyEquiv -> PatternSubstitution
infoRho UnifyEquiv
info
    itau :: Substitution' Term
itau = UnifyEquiv -> Substitution' Term
infoTau UnifyEquiv
info
    ileftInv :: Substitution' Term
ileftInv = UnifyEquiv -> Substitution' Term
infoLeftInv UnifyEquiv
info
  interval <- TCMT IO Term -> TCMT IO Type
forall (m :: * -> *). Functor m => m Term -> m Type
elInf TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primInterval
  tTrans  <- primTrans
  tComp  <- fromMaybe __IMPOSSIBLE__ <$> getTerm' builtinComp
  conId <- fromMaybe __IMPOSSIBLE__ <$> getName' builtinConId
  let bindSplit (Telescope
tel1,a
tel2) = (Telescope
tel1,[String] -> a -> AbsN a
forall a. [String] -> a -> AbsN a
AbsN (Telescope -> [String]
teleNames Telescope
tel1) a
tel2)
  let
      old_tel = SplitClause -> Telescope
scTel SplitClause
old_sc

  -- old_tel = Γ(x: Id A u v)Δ
  -- Γ(x: Id A u v)Δ ⊢ old_t
  -- Γ ⊢ hdelta = (x : Id A u v)(δ : Δ)
      pair@(_gamma,_hdelta@(ExtendTel hdom delta)) = splitTelescopeAt (size old_tel - (blockingVarNo x + 1)) old_tel
      (gamma,hdelta) = bindSplit pair
      old_t  = [String] -> Dom Type -> AbsN (Dom Type)
forall a. [String] -> a -> AbsN a
AbsN (Telescope -> [String]
teleNames Telescope
old_tel) (Dom Type -> AbsN (Dom Type)) -> Dom Type -> AbsN (Dom Type)
forall a b. (a -> b) -> a -> b
$ 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_ps = [String] -> [Elim] -> AbsN [Elim]
forall a. [String] -> a -> AbsN a
AbsN (Telescope -> [String]
teleNames Telescope
old_tel) ([Elim] -> AbsN [Elim]) -> [Elim] -> AbsN [Elim]
forall a b. (a -> b) -> a -> b
$ [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_ps' = [String]
-> [NamedArg DeBruijnPattern] -> AbsN [NamedArg DeBruijnPattern]
forall a. [String] -> a -> AbsN a
AbsN (Telescope -> [String]
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

  params <- runNamesT [] $ do
    hdelta <- open hdelta
    bindN (teleNames gamma) $ \ Vars (TCMT IO)
args -> do
       hdelta@(ExtendTel hdom _) <- 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) (AbsN Telescope)
hdelta [NamesT (TCMT IO) Term]
[NamesT (TCMT IO) (SubstArg Telescope)]
Vars (TCMT IO)
args
       Def _Id es@[_,_,_,_] <- reduce $ unEl $ unDom hdom
       return $ map unArg $ fromMaybe __IMPOSSIBLE__ $ allApplyElims es

  working_tel <- runNamesT [] $ do
    hdelta <- open hdelta
    params <- open params
    abstractN (pure gamma) $ \ Vars (TCMT IO)
args -> do
      pTel <- Telescope -> NamesT (TCMT IO) (NamesT (TCMT IO) Telescope)
forall (m :: * -> *) a.
(MonadFail 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
=<< TCMT IO Telescope -> NamesT (TCMT IO) Telescope
forall (m :: * -> *) a. Monad m => m a -> NamesT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Telescope -> Args -> Args -> TCMT IO Telescope
forall (m :: * -> *).
(PureTCM m, MonadError TCErr m) =>
Telescope -> Args -> Args -> m Telescope
pathTelescope (UnifyEquiv -> Telescope
infoEqTel UnifyEquiv
info) ((Term -> Arg Term) -> [Term] -> Args
forall a b. (a -> b) -> [a] -> [b]
map Term -> Arg Term
forall e. e -> Arg e
defaultArg ([Term] -> Args) -> [Term] -> Args
forall a b. (a -> b) -> a -> b
$ UnifyEquiv -> [Term]
infoEqLHS UnifyEquiv
info) ((Term -> Arg Term) -> [Term] -> Args
forall a b. (a -> b) -> [a] -> [b]
map Term -> Arg Term
forall e. e -> Arg e
defaultArg ([Term] -> Args) -> [Term] -> Args
forall a b. (a -> b) -> a -> b
$ UnifyEquiv -> [Term]
infoEqRHS UnifyEquiv
info))
      abstractN (pure (telFromList [defaultDom ("phi",interval)] :: Telescope)) $ \ [NamesT (TCMT IO) Term
phi] ->
        NamesT (TCMT IO) Telescope
-> (Vars (TCMT IO) -> NamesT (TCMT IO) Telescope)
-> NamesT (TCMT IO) Telescope
forall (m :: * -> *) a.
(MonadFail m, Abstract a) =>
NamesT m Telescope -> (Vars m -> NamesT m a) -> NamesT m a
abstractN NamesT (TCMT IO) Telescope
pTel ((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
$ \ [NamesT (TCMT IO) Term
p] -> do
          [l,bA,x,y] <- (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.
(MonadFail 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) (AbsN [Term])
-> [NamesT (TCMT IO) (SubstArg [Term])] -> NamesT (TCMT IO) [Term]
forall (m :: * -> *) a.
(Monad m, Subst a) =>
NamesT m (AbsN a) -> [NamesT m (SubstArg a)] -> NamesT m a
applyN NamesT (TCMT IO) (AbsN [Term])
params [NamesT (TCMT IO) Term]
[NamesT (TCMT IO) (SubstArg [Term])]
Vars (TCMT IO)
args
          apply1 <$> applyN hdelta args <*> (cl primConId <#> l <#> bA <#> x <#> y <@> phi <@> p)
  -- working_tel ⊢ i. γ[leftInv i]
  (gamma_args_left :: Abs [Term], con_phi_p_left :: Abs Term) <- fmap (raise (size delta) . unAbsN) . runNamesT [] $ do
    params <- open params
    bindN (teleNames gamma ++ ["phi","p"]) $ \ Vars (TCMT IO)
args' -> do
      let ([NamesT (TCMT IO) Term]
args,[NamesT (TCMT IO) Term
phi,NamesT (TCMT IO) Term
p]) = Int
-> [NamesT (TCMT IO) Term]
-> ([NamesT (TCMT IO) Term], [NamesT (TCMT IO) Term])
forall a. Int -> [a] -> ([a], [a])
splitAt (Telescope -> Int
forall a. Sized a => a -> Int
size Telescope
gamma) [NamesT (TCMT IO) Term]
Vars (TCMT IO)
args'
      [l,bA,x,y] <- (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.
(MonadFail 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) (AbsN [Term])
-> [NamesT (TCMT IO) (SubstArg [Term])] -> NamesT (TCMT IO) [Term]
forall (m :: * -> *) a.
(Monad m, Subst a) =>
NamesT m (AbsN a) -> [NamesT m (SubstArg a)] -> NamesT m a
applyN NamesT (TCMT IO) (AbsN [Term])
params [NamesT (TCMT IO) Term]
[NamesT (TCMT IO) (SubstArg [Term])]
args
      gargs <- Abs "i" . applySubst ileftInv <$> sequence args
      con_phi_p <- Abs "i" . applySubst ileftInv <$> do
        (cl primConId <#> l <#> bA <#> x <#> y <@> phi <@> p)
      return (gargs,con_phi_p)
  ps <- fmap unAbsN . runNamesT [] $ do
    old_ps' <- open $ old_ps'
    params <- open params
    bindN (teleNames working_tel) $ \ ([NamesT (TCMT IO) Term]
wargs :: [NamesT TCM Term]) -> do
      let ([NamedArg DeBruijnPattern]
g,NamedArg DeBruijnPattern
phi:NamedArg DeBruijnPattern
p:[NamedArg DeBruijnPattern]
d) = Int
-> [NamedArg DeBruijnPattern]
-> ([NamedArg DeBruijnPattern], [NamedArg DeBruijnPattern])
forall a. Int -> [a] -> ([a], [a])
splitAt (Telescope -> Int
forall a. Sized a => a -> Int
size Telescope
gamma) ([NamedArg DeBruijnPattern]
 -> ([NamedArg DeBruijnPattern], [NamedArg DeBruijnPattern]))
-> [NamedArg DeBruijnPattern]
-> ([NamedArg DeBruijnPattern], [NamedArg DeBruijnPattern])
forall a b. (a -> b) -> a -> b
$ Telescope -> [(Term, (Term, Term))] -> [NamedArg DeBruijnPattern]
forall a.
DeBruijn a =>
Telescope -> [(Term, (Term, Term))] -> [NamedArg (Pattern' a)]
telePatterns Telescope
working_tel []
      params <- (Term -> NamedArg DeBruijnPattern)
-> [Term] -> [NamedArg DeBruijnPattern]
forall a b. (a -> b) -> [a] -> [b]
map (Named_ DeBruijnPattern -> NamedArg DeBruijnPattern
forall e. e -> Arg e
argH (Named_ DeBruijnPattern -> NamedArg DeBruijnPattern)
-> (Term -> Named_ DeBruijnPattern)
-> Term
-> NamedArg DeBruijnPattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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) ([Term] -> [NamedArg DeBruijnPattern])
-> NamesT (TCMT IO) [Term]
-> NamesT (TCMT IO) [NamedArg DeBruijnPattern]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamesT (TCMT IO) (AbsN [Term])
-> [NamesT (TCMT IO) (SubstArg [Term])] -> NamesT (TCMT IO) [Term]
forall (m :: * -> *) a.
(Monad m, Subst a) =>
NamesT m (AbsN a) -> [NamesT m (SubstArg a)] -> NamesT m a
applyN NamesT (TCMT IO) (AbsN [Term])
params (Int -> [NamesT (TCMT IO) Term] -> [NamesT (TCMT IO) Term]
forall a. Int -> [a] -> [a]
take (Telescope -> Int
forall a. Sized a => a -> Int
size Telescope
gamma) [NamesT (TCMT IO) Term]
wargs)
      let x = PatternInfo
-> QName -> [NamedArg DeBruijnPattern] -> DeBruijnPattern
forall x.
PatternInfo -> QName -> [NamedArg (Pattern' x)] -> Pattern' x
DefP PatternInfo
defaultPatternInfo QName
conId ([NamedArg DeBruijnPattern] -> DeBruijnPattern)
-> [NamedArg DeBruijnPattern] -> DeBruijnPattern
forall a b. (a -> b) -> a -> b
$ [NamedArg DeBruijnPattern]
params [NamedArg DeBruijnPattern]
-> [NamedArg DeBruijnPattern] -> [NamedArg DeBruijnPattern]
forall a. [a] -> [a] -> [a]
++ [NamedArg DeBruijnPattern
phi,NamedArg DeBruijnPattern
p]
      args <- open $ map namedArg g ++ [x] ++ map namedArg d
      applyN' old_ps' args
  -- tel = Γ',Δ[ρ,x = refl]
  -- Γ' ⊢ ρ : Γ
  -- Γ' ⊢ u[ρ] = v[ρ] : A[ρ]

  -- Γ' ⊢ ρ,x=refl : Γ,(x : Id A u v)

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

  -- Γ' ⊢ [ρ,x = refl u[ρ]] : Γ,(x : Id A u v)

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

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

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

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

  -- Γ,(φ : 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 u[ρ[τ]],δ] : old_t[ρ,x = refl][τ'] = old_t[ρ[τ],x = refl u[ρ[τ]],δ]

  -- Γ,(φ : I),(p : Path A u v) | (i : I) ⊢ μ = ⟨φ,p⟩[leftInv (~i)] : (Id A u v)[γ[leftInv (~ i)]]
  --                                     μ[0] = ⟨ φ             , p    ⟩
  --                                     μ[1] = ⟨ 1             , refl ⟩

  -- Γ,(φ : I),(p : Path A u v),(δ : Δ[x = ⟨ φ , p ⟩]) ⊢
  --         δ_f[1] = vecTransp (i. Δ[γ[leftInv (~ i)], ⟨φ,p⟩[leftInv (~i)]]) φ δ : Δ[ρ[τ], x = refl u[ρ[τ]]]

  -- Γ,(φ : I),(p : Path A u v),(δ : Δ[x = ⟨ φ , p ⟩]) ⊢ w[δ_f[1]] : old_t[ρ[τ],x = refl u[ρ[τ]],δ_f[1]]
  -- Γ,(φ : I),(p : Path A u v),Δ[x = ⟨ φ , p ⟩] ⊢ rhs = transp (i. old_t[γ[leftInv i],x = ⟨φ,p⟩[leftInv i], δ_f[~i]]) φ (w[δ_f[1]]) : old_t[γ,x = ⟨ φ , p ⟩,δ]
  let
      getLevel a
t = do
        s <- Sort -> m Sort
forall a (m :: * -> *). (Reduce a, MonadReduce m) => a -> m a
reduce (Sort -> m Sort) -> Sort -> m Sort
forall a b. (a -> b) -> a -> b
$ a -> Sort
forall a. LensSort a => a -> Sort
getSort a
t
        case s of
          Type Level
l -> Term -> m Term
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Level -> Term
Level Level
l)
          Sort
s      -> do
            String -> Int -> TCMT IO Doc -> m ()
forall (m :: * -> *).
MonadDebug m =>
String -> Int -> TCMT IO Doc -> m ()
reportSDoc String
"tc.cover.hcomp" Int
20 (TCMT IO Doc -> m ()) -> TCMT IO Doc -> m ()
forall a b. (a -> b) -> a -> b
$ String -> TCMT IO Doc
forall (m :: * -> *). Applicative m => String -> m Doc
text String
"getLevel, 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
            TypeError -> m Term
forall (m :: * -> *) a.
(HasCallStack, MonadTCError m) =>
TypeError -> m a
typeError (TypeError -> m Term) -> (Doc -> TypeError) -> Doc -> m Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> TypeError
GenericDocError (Doc -> m Term) -> m Doc -> m Term
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
                    (String -> m Doc
forall (m :: * -> *). Applicative m => String -> m Doc
text String
"The sort of" m Doc -> m Doc -> m Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> a -> m Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
forall (m :: * -> *). MonadPretty m => a -> m Doc
prettyTCM a
t m Doc -> m Doc -> m Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> String -> m Doc
forall (m :: * -> *). Applicative m => String -> m Doc
text String
"should be of the form \"Set l\"")
  (ty,rhs) <- addContext working_tel $ runNamesT [] $ do
    let
        raiseFrom :: Subst a => Telescope -> a -> a
        raiseFrom Telescope
tel a
x = Int -> a -> a
forall a. Subst a => Int -> a -> a
raise (Telescope -> Int
forall a. Sized a => a -> Int
size Telescope
working_tel Int -> Int -> Int
forall a. Num a => a -> a -> a
- Telescope -> Int
forall a. Sized a => a -> Int
size Telescope
tel) a
x
        all_args = Telescope -> Args
forall a t. DeBruijn a => Tele (Dom t) -> [Arg a]
teleArgs Telescope
working_tel :: Args
        (gamma_args,phi:p:delta_args) = splitAt (size gamma) all_args
    old_t <- open $ raiseFrom EmptyTel old_t
    old_ps <- open $ raiseFrom EmptyTel old_ps
    delta_args <- open delta_args
    gamma_args_left <- open gamma_args_left
    con_phi_p_left <- open con_phi_p_left
    hdelta <- open $ raiseFrom gamma hdelta
    delta_f <- bind "i" $ \ Var (TCMT IO)
i -> do
      Telescope -> Term -> Telescope
forall t. Apply t => t -> Term -> t
apply1 (Telescope -> Term -> Telescope)
-> NamesT (TCMT IO) Telescope
-> NamesT (TCMT IO) (Term -> Telescope)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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) (AbsN Telescope)
hdelta (Abs [Term] -> Term -> [Term]
Abs [Term] -> SubstArg [Term] -> [Term]
forall a. Subst a => Abs a -> SubstArg a -> a
lazyAbsApp (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])
gamma_args_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
<*> (TCMT IO Term -> NamesT (TCMT IO) Term
forall (m :: * -> *) a. Monad m => m a -> NamesT m a
cl TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primINeg 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)
i)) NamesT (TCMT IO) (Term -> Telescope)
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Telescope
forall a b.
NamesT (TCMT IO) (a -> b)
-> NamesT (TCMT IO) a -> NamesT (TCMT IO) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Abs Term -> Term -> Term
Abs Term -> SubstArg Term -> Term
forall a. Subst a => Abs a -> SubstArg a -> a
lazyAbsApp (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)
con_phi_p_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
<*> (TCMT IO Term -> NamesT (TCMT IO) Term
forall (m :: * -> *) a. Monad m => m a -> NamesT m a
cl TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primINeg 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)
i))
    delta_f <- open delta_f
    [phi,p] <- mapM (open . unArg) [phi,p]
    delta_args_f <- bind "i" $ \ Var (TCMT IO)
i -> do

      m <- Bool
-> Abs Telescope
-> Term
-> Args
-> Term
-> ExceptT (Closure (Abs Type)) (TCMT IO) Args
forall (m :: * -> *).
(PureTCM m, MonadError TCErr m) =>
Bool
-> Abs Telescope
-> Term
-> Args
-> Term
-> ExceptT (Closure (Abs Type)) m Args
trFillTel' Bool
True (Abs Telescope
 -> Term
 -> Args
 -> Term
 -> ExceptT (Closure (Abs Type)) (TCMT IO) Args)
-> NamesT (TCMT IO) (Abs Telescope)
-> NamesT
     (TCMT IO)
     (Term
      -> Args -> Term -> ExceptT (Closure (Abs Type)) (TCMT IO) Args)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamesT (TCMT IO) (Abs Telescope)
delta_f NamesT
  (TCMT IO)
  (Term
   -> Args -> Term -> ExceptT (Closure (Abs Type)) (TCMT IO) Args)
-> NamesT (TCMT IO) Term
-> NamesT
     (TCMT IO)
     (Args -> Term -> ExceptT (Closure (Abs Type)) (TCMT IO) Args)
forall a b.
NamesT (TCMT IO) (a -> b)
-> NamesT (TCMT IO) a -> NamesT (TCMT IO) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> NamesT (TCMT IO) Term
phi NamesT
  (TCMT IO)
  (Args -> Term -> ExceptT (Closure (Abs Type)) (TCMT IO) Args)
-> NamesT (TCMT IO) Args
-> NamesT
     (TCMT IO) (Term -> ExceptT (Closure (Abs Type)) (TCMT IO) Args)
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) Args
delta_args NamesT
  (TCMT IO) (Term -> ExceptT (Closure (Abs Type)) (TCMT IO) Args)
-> NamesT (TCMT IO) Term
-> NamesT (TCMT IO) (ExceptT (Closure (Abs Type)) (TCMT IO) Args)
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
      either __IMPOSSIBLE__ id <$> lift (runExceptT m)
    delta_args_f <- open delta_args_f
    old_t_f <- (open =<<) $ bind "i" $ \ Var (TCMT IO)
i -> do
      g <- Abs [Term] -> Term -> [Term]
Abs [Term] -> SubstArg [Term] -> [Term]
forall a. Subst a => Abs a -> SubstArg a -> a
lazyAbsApp (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])
gamma_args_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
      x <- lazyAbsApp <$> con_phi_p_left <*> i
      d <- lazyAbsApp <$> delta_args_f <*> (cl primINeg <@> i)
      args <- open $ g ++ [x] ++ map unArg d
      applyN' old_t args
    w <- (open =<<) $ bind "i" $ \ Var (TCMT IO)
i -> do
      g <- Abs [Term] -> Term -> [Term]
Abs [Term] -> SubstArg [Term] -> [Term]
forall a. Subst a => Abs a -> SubstArg a -> a
lazyAbsApp (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])
gamma_args_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
      x <- lazyAbsApp <$> con_phi_p_left <*> i
      d <- lazyAbsApp <$> delta_args_f <*> (cl primINeg <@> i)
      args <- open $ g ++ [x] ++ map unArg d
      Def f <$> applyN' old_ps args

    ps <- open ps
    max <- primIMax
    iz <- primIZero
    alphas <- (open =<<) $ do
      vs <- iApplyVars <$> ps
      neg <- primINeg
      zero <- primIZero
      return $ foldr (\ Term
x Term
r -> Term
max Term -> Args -> Term
forall t. Apply t => t -> Args -> t
`apply` [Term -> Arg Term
forall e. e -> Arg e
argN (Term -> Arg Term) -> Term -> Arg Term
forall a b. (a -> b) -> a -> b
$ Term
max Term -> Args -> Term
forall t. Apply t => t -> Args -> t
`apply` [Term -> Arg Term
forall e. e -> Arg e
argN Term
x, Term -> Arg Term
forall e. e -> Arg e
argN (Term
neg Term -> Args -> Term
forall t. Apply t => t -> Args -> t
`apply` [Term -> Arg Term
forall e. e -> Arg e
argN Term
x])], Term -> Arg Term
forall e. e -> Arg e
argN Term
r]) zero $ map var vs
    sides <- (open =<<) $ do
      neg <- primINeg
      io <- primIOne
      bind "i" $ \ Var (TCMT IO)
i -> do
        vs <- [NamedArg DeBruijnPattern] -> [Int]
forall p. IApplyVars p => p -> [Int]
iApplyVars ([NamedArg DeBruijnPattern] -> [Int])
-> NamesT (TCMT IO) [NamedArg DeBruijnPattern]
-> NamesT (TCMT IO) [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamesT (TCMT IO) [NamedArg DeBruijnPattern]
ps
        tm <- lazyAbsApp <$> w <*> i
        xs <- forM vs $ \ Int
v ->
          -- have to reduce these under the appropriate substitutions, otherwise non-normalizing
          ((Term, Term) -> (Term, (Term, Term)))
-> NamesT (TCMT IO) (Term, Term)
-> NamesT (TCMT IO) (Term, (Term, 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) (Term, Term)
 -> NamesT (TCMT IO) (Term, (Term, Term)))
-> ((Term, Term) -> NamesT (TCMT IO) (Term, Term))
-> (Term, Term)
-> NamesT (TCMT IO) (Term, (Term, Term))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Term, Term) -> NamesT (TCMT IO) (Term, Term)
forall a (m :: * -> *). (Reduce a, MonadReduce m) => a -> m a
reduce ((Term, Term) -> NamesT (TCMT IO) (Term, (Term, Term)))
-> (Term, Term) -> NamesT (TCMT IO) (Term, (Term, Term))
forall a b. (a -> b) -> a -> b
$ (Int -> Term -> Substitution' Term
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' Term
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)
        phiv <- fromMaybe __IMPOSSIBLE__ . deBruijnView <$> phi
        -- extra assumption: phi |- w i = w 0, otherwise we need [ phi -> w 0 ] specifically
        tm_phi <- reduce $ inplaceS phiv io `applySubst` tm
        phi <- phi
        return $ (phi,tm_phi) : concatMap (\(Term
v,(Term
l,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],Term
l),(Term
v,Term
r)]) xs

    let imax Term
i Term
j = Term -> Args -> Term
forall t. Apply t => t -> Args -> t
apply Term
max (Args -> Term) -> Args -> Term
forall a b. (a -> b) -> a -> b
$ (Term -> Arg Term) -> [Term] -> Args
forall a b. (a -> b) -> [a] -> [b]
map Term -> Arg Term
forall e. e -> Arg e
argN [Term
i,Term
j]
    tPOr <- fromMaybe __IMPOSSIBLE__ <$> getTerm' builtinPOr
    let
      pOr NamesT (TCMT IO) Term
l NamesT (TCMT IO) Term
ty Term
phi Term
psi Term
u0 NamesT (TCMT IO) Term
u1 = do
          [phi,psi] <- (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.
(MonadFail m, Subst a) =>
a -> NamesT m (NamesT m a)
open [Term
phi,Term
psi]
          pure tPOr <#> l
                    <@> phi <@> psi
                    <#> ilam "o" (\ NamesT (TCMT IO) Term
_ -> NamesT (TCMT IO) Term
ty) <@> noilam u0 <@> u1

      noilam Term
u = do
         u <- Term -> NamesT m (NamesT m Term)
forall (m :: * -> *) a.
(MonadFail m, Subst a) =>
a -> NamesT m (NamesT m a)
open Term
u
         ilam "o" $ \ NamesT m Term
_ -> NamesT m Term
u

      combine NamesT (TCMT IO) Term
l NamesT (TCMT IO) Term
ty [] = NamesT (TCMT IO) Term
forall a. HasCallStack => a
__IMPOSSIBLE__
      combine NamesT (TCMT IO) Term
l NamesT (TCMT IO) Term
ty [(Term
psi,Term
u)] = Term -> NamesT (TCMT IO) Term
forall {m :: * -> *}. MonadFail m => Term -> NamesT m Term
noilam Term
u
      combine NamesT (TCMT IO) Term
l NamesT (TCMT IO) Term
ty ((Term
psi,Term
u):[(Term, Term)]
xs) = NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term
-> Term
-> Term
-> Term
-> NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term
pOr NamesT (TCMT IO) Term
l NamesT (TCMT IO) Term
ty Term
psi ((Term -> Term -> Term) -> Term -> [Term] -> Term
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Term -> Term -> Term
imax Term
iz (((Term, Term) -> Term) -> [(Term, Term)] -> [Term]
forall a b. (a -> b) -> [a] -> [b]
map (Term, Term) -> Term
forall a b. (a, b) -> a
fst [(Term, Term)]
xs)) Term
u (NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> [(Term, Term)] -> NamesT (TCMT IO) Term
combine NamesT (TCMT IO) Term
l NamesT (TCMT IO) Term
ty [(Term, Term)]
xs)

    let ty NamesT (TCMT IO) Term
i = Abs (Dom Type) -> Term -> Dom Type
Abs (Dom Type) -> SubstArg (Dom Type) -> Dom Type
forall a. Subst a => Abs a -> SubstArg a -> a
lazyAbsApp (Abs (Dom Type) -> Term -> Dom Type)
-> NamesT (TCMT IO) (Abs (Dom Type))
-> NamesT (TCMT IO) (Term -> Dom Type)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamesT (TCMT IO) (Abs (Dom Type))
old_t_f NamesT (TCMT IO) (Term -> Dom Type)
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) (Dom Type)
forall a b.
NamesT (TCMT IO) (a -> b)
-> NamesT (TCMT IO) a -> NamesT (TCMT IO) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> NamesT (TCMT IO) Term
i
    l <- (open =<<) $ lam "i" $ \ NamesT (TCMT IO) Term
i -> do
           t <- Dom Type -> Type
forall t e. Dom' t e -> e
unDom (Dom Type -> Type)
-> NamesT (TCMT IO) (Dom Type) -> NamesT (TCMT IO) Type
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamesT (TCMT IO) Term -> NamesT (TCMT IO) (Dom Type)
ty NamesT (TCMT IO) Term
i
           lift $ getLevel t
    ((,) <$> ty (cl primIOne) <*>) $ do
         n <- length . unAbs <$> sides
         -- TODO don't comp if the family and the sides "j. [ α ↦ u ]" are constant?
         if n > 1 then
           pure tComp <#> l <@> lam "i" (\ NamesT (TCMT IO) Term
i -> 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)
-> NamesT (TCMT IO) (Dom Type) -> NamesT (TCMT IO) Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamesT (TCMT IO) Term -> NamesT (TCMT IO) (Dom Type)
ty NamesT (TCMT IO) Term
i)
                <@> (cl primIMax <@> phi <@> alphas)
                <@> lam "i" (\ NamesT (TCMT IO) Term
i -> NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> [(Term, Term)] -> NamesT (TCMT IO) Term
combine (NamesT (TCMT IO) Term
l 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) (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)
-> NamesT (TCMT IO) (Dom Type) -> NamesT (TCMT IO) Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamesT (TCMT IO) Term -> NamesT (TCMT IO) (Dom Type)
ty NamesT (TCMT IO) Term
i) ([(Term, Term)] -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) [(Term, Term)] -> NamesT (TCMT IO) Term
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Abs [(Term, Term)] -> Term -> [(Term, Term)]
Abs [(Term, Term)] -> SubstArg [(Term, Term)] -> [(Term, Term)]
forall a. Subst a => Abs a -> SubstArg a -> a
lazyAbsApp (Abs [(Term, Term)] -> Term -> [(Term, Term)])
-> NamesT (TCMT IO) (Abs [(Term, Term)])
-> NamesT (TCMT IO) (Term -> [(Term, Term)])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamesT (TCMT IO) (Abs [(Term, Term)])
sides NamesT (TCMT IO) (Term -> [(Term, Term)])
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) [(Term, 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))
                <@> (lazyAbsApp <$> w <*> primIZero)
         else
           pure tTrans <#> l <@> lam "i" (\ NamesT (TCMT IO) Term
i -> 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)
-> NamesT (TCMT IO) (Dom Type) -> NamesT (TCMT IO) Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamesT (TCMT IO) Term -> NamesT (TCMT IO) (Dom Type)
ty NamesT (TCMT IO) Term
i)
                <@> phi
                <@> (lazyAbsApp <$> w <*> primIZero)

  reportSDoc "tc.cover.conid" 20 $ text "conid case for" <+> text (show f)
  reportSDoc "tc.cover.conid" 20 $ text "tel =" <+> prettyTCM working_tel
  reportSDoc "tc.cover.conid" 25 $ addContext working_tel $ prettyTCM 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
working_tel
                    , namedClausePats :: [NamedArg DeBruijnPattern]
namedClausePats = [NamedArg DeBruijnPattern]
ps
                    , clauseBody :: Maybe Term
clauseBody      = Term -> Maybe Term
forall a. a -> Maybe a
Just (Term -> Maybe Term) -> Term -> Maybe Term
forall a b. (a -> b) -> a -> b
$ Term
rhs
                    , 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 t e. Dom' t e -> ArgInfo
domInfo Dom Type
ty) (Dom Type -> Type
forall t e. Dom' t e -> e
unDom Dom Type
ty)
                    , clauseCatchall :: Bool
clauseCatchall    = Bool
False
                    , clauseUnreachable :: Maybe Bool
clauseUnreachable = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False  -- missing, thus, not unreachable
                    , clauseRecursive :: Maybe Bool
clauseRecursive   = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False
                    , clauseEllipsis :: ExpandedEllipsis
clauseEllipsis    = ExpandedEllipsis
NoEllipsis
                    , clauseExact :: Maybe Bool
clauseExact       = Maybe Bool
forall a. Maybe a
Nothing
                    , clauseWhereModule :: Maybe ModuleName
clauseWhereModule = Maybe ModuleName
forall a. Maybe a
Nothing
                    }
  addClauses f [cl]
  return $ Just ((SplitCon conId,SplittingDone (size working_tel)),cl)
createMissingConIdClause QName
f Arg Int
n BlockingVar
x SplitClause
old_sc IInfo
NoInfo = Maybe ((SplitTag, SplitTree' SplitTag), Clause)
-> TCM (Maybe ((SplitTag, SplitTree' SplitTag), Clause))
forall a. a -> TCMT IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ((SplitTag, SplitTree' SplitTag), Clause)
forall a. Maybe a
Nothing


{-
  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' Term)
_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
  String -> Int -> TCMT IO Doc -> TCMT IO ()
forall (m :: * -> *).
MonadDebug m =>
String -> Int -> TCMT IO Doc -> m ()
reportSDoc String
"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
$ String -> TCMT IO Doc
forall (m :: * -> *). Applicative m => String -> m Doc
text String
"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
  String -> Int -> TCMT IO Doc -> TCMT IO ()
forall (m :: * -> *).
MonadDebug m =>
String -> Int -> TCMT IO Doc -> m ()
reportSDoc String
"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
$ String -> TCMT IO Doc
forall (m :: * -> *). Applicative m => String -> m Doc
text String
"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)
  String -> Int -> TCMT IO Doc -> TCMT IO ()
forall (m :: * -> *).
MonadDebug m =>
String -> Int -> TCMT IO Doc -> m ()
reportSDoc String
"tc.cover.hcomp" Int
30 (TCMT IO Doc -> TCMT IO ()) -> TCMT IO Doc -> TCMT IO ()
forall a b. (a -> b) -> a -> b
$ String -> TCMT IO Doc
forall (m :: * -> *). Applicative m => String -> m Doc
text String
"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
      TypeError -> m a
forall (m :: * -> *) a.
(HasCallStack, MonadTCError m) =>
TypeError -> m a
typeError (TypeError -> m a)
-> (SplitError -> TypeError) -> SplitError -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SplitError -> TypeError
SplitError (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 a
t = do
        s <- Sort -> m Sort
forall a (m :: * -> *). (Reduce a, MonadReduce m) => a -> m a
reduce (Sort -> m Sort) -> Sort -> m Sort
forall a b. (a -> b) -> a -> b
$ a -> Sort
forall a. LensSort a => a -> Sort
getSort a
t
        case s of
          Type Level
l -> Term -> m Term
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Level -> Term
Level Level
l)
          Sort
s      -> do
            String -> Int -> TCMT IO Doc -> m ()
forall (m :: * -> *).
MonadDebug m =>
String -> Int -> TCMT IO Doc -> m ()
reportSDoc String
"tc.cover.hcomp" Int
20 (TCMT IO Doc -> m ()) -> TCMT IO Doc -> m ()
forall a b. (a -> b) -> a -> b
$ String -> TCMT IO Doc
forall (m :: * -> *). Applicative m => String -> m Doc
text String
"getLevel, 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
            TypeError -> m Term
forall (m :: * -> *) a.
(HasCallStack, MonadTCError m) =>
TypeError -> m a
typeError (TypeError -> m Term) -> (Doc -> TypeError) -> Doc -> m Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> TypeError
GenericDocError (Doc -> m Term) -> m Doc -> m Term
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
                    (String -> m Doc
forall (m :: * -> *). Applicative m => String -> m Doc
text String
"The sort of" m Doc -> m Doc -> m Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> a -> m Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
forall (m :: * -> *). MonadPretty m => a -> m Doc
prettyTCM a
t m Doc -> m Doc -> m Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> String -> m Doc
forall (m :: * -> *). Applicative m => String -> m Doc
text String
"should be of the form \"Set l\"")

      -- Γ ⊢ 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' Term
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' Term
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))
                                               (String
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
lam String
"j" ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
 -> NamesT (TCMT IO) Term)
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall a b. (a -> b) -> a -> b
$ \ NamesT (TCMT IO) Term
j -> 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
<#> String
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
ilam String
"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
<@> String
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
ilam String
"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
<@> String
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
ilam String
"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
forall {m :: * -> *} {a}.
(LensSort a, MonadError TCErr m, PrettyTCM a, MonadFresh NameId m,
 MonadInteractionPoints m, MonadStConcreteNames m, PureTCM m,
 IsString (m Doc), Null (m Doc), Semigroup (m Doc)) =>
a -> m 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) ⊢
          [phi,u,u0] <- mapM (open . raise (size delta) . var) [2,1,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 -> String -> 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 => String -> m a -> m a
addContext (String
"i" :: String) (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 <- do
                return $ \ 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.
(MonadFail 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
=<< String
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
lam String
"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 <- TCM (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 -> TCM (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
<#> String
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
ilam String
"o" (\ NamesT (TCMT IO) Term
_ -> Type -> Term
forall t a. Type'' t a -> a
unEl (Type -> Term) -> NamesT (TCMT IO) Type -> NamesT (TCMT IO) Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamesT (TCMT IO) 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.
(MonadFail 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' Term
Substitution' (SubstArg Term)
hcompS Substitution' (SubstArg Term) -> Term -> Term
forall a. Subst a => Substitution' (SubstArg a) -> a -> a
`applySubst` Term
psi

                [side0, side1] <- mapM (open . raise (3 + size delta) . abstract hdelta) [side0, 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 (String
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
ilam String
"o" ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
 -> NamesT (TCMT IO) Term)
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall a b. (a -> b) -> a -> b
$ \ NamesT (TCMT IO) Term
_ -> NamesT (TCMT IO) Term
-> 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)
                                                            (String
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
ilam String
"o" ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
 -> NamesT (TCMT IO) Term)
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall a b. (a -> b) -> a -> b
$ \ NamesT (TCMT IO) Term
_ -> NamesT (TCMT IO) Term
-> 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) <*>) $ do
            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 = (String
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
ilam String
"o" ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
 -> NamesT (TCMT IO) Term)
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall a b. (a -> b) -> a -> b
$ \ NamesT (TCMT IO) Term
o -> 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    = False
                    , clauseExact       = Just True
                    , clauseRecursive   = Nothing     -- 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' Term)
_ Maybe (Dom Type)
Nothing) [Clause]
_ = TCM ([(SplitTag, CoverResult)], [Clause])
forall a. HasCallStack => a
__IMPOSSIBLE__