{-# LANGUAGE NondecreasingIndentation #-}

module Agda.TypeChecking.Coverage.Cubical where

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

import Control.Monad.Except ( runExceptT )

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

import Agda.Syntax.Common hiding (DataOrRecord)
import Agda.Syntax.Position
import Agda.Syntax.Internal
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.SplitPattern
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.Either ( fromRight )
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
  let infos :: [(QName, UnifyEquiv)]
infos = [(QName
c,UnifyEquiv
i) | (SplitCon QName
c, (SplitClause
_,TheInfo UnifyEquiv
i)) <- [(SplitTag, (SplitClause, IInfo))]
scs ]
  case [(SplitTag, (SplitClause, IInfo))]
scs of
    [(SplitTag, (SplitClause, IInfo))]
xs | (QName, UnifyEquiv)
info:[(QName, UnifyEquiv)]
_ <- [(QName, UnifyEquiv)]
infos -> do
         [Char] -> Int -> TCMT IO Doc -> TCMT IO ()
forall (m :: * -> *).
MonadDebug m =>
[Char] -> Int -> TCMT IO Doc -> m ()
reportSDoc [Char]
"tc.cover.indexed" Int
20 (TCMT IO Doc -> TCMT IO ()) -> TCMT IO Doc -> TCMT IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> TCMT IO Doc
forall (m :: * -> *). Applicative m => [Char] -> m Doc
text [Char]
"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)
         [Char] -> Int -> TCMT IO Doc -> TCMT IO ()
forall (m :: * -> *).
MonadDebug m =>
[Char] -> Int -> TCMT IO Doc -> m ()
reportSDoc [Char]
"tc.cover.indexed" Int
20 (TCMT IO Doc -> TCMT IO ()) -> TCMT IO Doc -> TCMT IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> TCMT IO Doc
forall (m :: * -> *). Applicative m => [Char] -> m Doc
text [Char]
"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 b (m :: * -> *). (IsBool b, Monad m) => b -> m () -> m ()
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
$
            [Char] -> Int -> TCMT IO Doc -> TCMT IO ()
forall (m :: * -> *).
MonadDebug m =>
[Char] -> Int -> TCMT IO Doc -> m ()
reportSDoc [Char]
"tc.cover.indexed" Int
20 (TCMT IO Doc -> TCMT IO ()) -> TCMT IO Doc -> TCMT IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> TCMT IO Doc
forall (m :: * -> *). Applicative m => [Char] -> m Doc
text [Char]
"missing some infos"
            -- Andrea: what to do when we only managed to build a unification proof for some of the constructors?
         Constructor{conData} <- Definition -> Defn
theDef (Definition -> Defn) -> TCMT IO Definition -> TCMT IO Defn
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> QName -> TCMT IO Definition
forall (m :: * -> *).
(HasConstInfo m, HasCallStack) =>
QName -> m Definition
getConstInfo ((QName, UnifyEquiv) -> QName
forall a b. (a, b) -> a
fst (QName, UnifyEquiv)
info)
         Datatype{dataPars = pars, dataIxs = nixs, dataTranspIx} <- theDef <$> getConstInfo conData
         hcomp <- fromMaybe __IMPOSSIBLE__ <$> getName' builtinHComp
         trX <- fromMaybe __IMPOSSIBLE__ <$> pure dataTranspIx
         trX_cl <- createMissingTrXTrXClause trX f n x old_sc
         hcomp_cl <- createMissingTrXHCompClause trX f n x old_sc
         (trees,cls) <- fmap unzip . forM infos $ \ (QName
c,UnifyEquiv
i) -> do
           cl <- QName
-> QName
-> Arg Int
-> BlockingVar
-> SplitClause
-> QName
-> UnifyEquiv
-> TCM Clause
createMissingTrXConClause QName
trX QName
f Arg Int
n BlockingVar
x SplitClause
old_sc QName
c UnifyEquiv
i
           return $ ((SplitCon c , SplittingDone (size $ clauseTel cl)) , cl)
         let extra = [ (QName -> SplitTag
SplitCon QName
trX, Int -> SplitTree' SplitTag
forall a. Int -> SplitTree' a
SplittingDone (Int -> SplitTree' SplitTag) -> Int -> SplitTree' SplitTag
forall a b. (a -> b) -> a -> b
$ Tele (Dom Type) -> Int
forall a. Sized a => a -> Int
size (Tele (Dom Type) -> Int) -> Tele (Dom Type) -> Int
forall a b. (a -> b) -> a -> b
$ Clause -> Tele (Dom Type)
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
$ Tele (Dom Type) -> Int
forall a. Sized a => a -> Int
size (Tele (Dom Type) -> Int) -> Tele (Dom Type) -> Int
forall a b. (a -> b) -> a -> b
$ Clause -> Tele (Dom Type)
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 :: [(Tele (Dom Type), [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 (Tele (Dom Type))
-> Term
-> [Arg Term]
-> Term
-> TCM [Term]
covFillTele QName
func Abs (Tele (Dom Type))
tel Term
face [Arg Term]
d Term
j = do
  ed_f <- TCM (Either (Closure (Abs Type)) [Arg Term])
-> TCM (Either (Closure (Abs Type)) [Arg Term])
forall a. TCM a -> TCM a
forall (tcm :: * -> *) a. MonadTCM tcm => TCM a -> tcm a
liftTCM (TCM (Either (Closure (Abs Type)) [Arg Term])
 -> TCM (Either (Closure (Abs Type)) [Arg Term]))
-> TCM (Either (Closure (Abs Type)) [Arg Term])
-> TCM (Either (Closure (Abs Type)) [Arg Term])
forall a b. (a -> b) -> a -> b
$ ExceptT (Closure (Abs Type)) (TCMT IO) [Arg Term]
-> TCM (Either (Closure (Abs Type)) [Arg Term])
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT (Closure (Abs Type)) (TCMT IO) [Arg Term]
 -> TCM (Either (Closure (Abs Type)) [Arg Term]))
-> ExceptT (Closure (Abs Type)) (TCMT IO) [Arg Term]
-> TCM (Either (Closure (Abs Type)) [Arg Term])
forall a b. (a -> b) -> a -> b
$ Abs (Tele (Dom Type))
-> Term
-> [Arg Term]
-> Term
-> ExceptT (Closure (Abs Type)) (TCMT IO) [Arg Term]
trFillTel Abs (Tele (Dom Type))
tel Term
face [Arg Term]
d Term
j
  case ed_f of
    Right [Arg Term]
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) -> [Arg Term] -> [Term]
forall a b. (a -> b) -> [a] -> [b]
map Arg Term -> Term
forall e. Arg e -> e
unArg [Arg Term]
d_f
    Left Closure (Abs Type)
failed_t -> TypeError -> TCM [Term]
forall (m :: * -> *) a.
(HasCallStack, MonadTCError m) =>
TypeError -> m a
typeError (TypeError -> TCM [Term]) -> TypeError -> TCM [Term]
forall a b. (a -> b) -> a -> b
$ QName -> Closure (Abs Type) -> TypeError
CannotGenerateTransportClause QName
func Closure (Abs Type)
failed_t

createMissingTrXTrXClause ::
     QName -- ^ trX
  -> QName -- ^ f defined
  -> Arg Nat
  -> BlockingVar
  -> SplitClause
  -> TCM Clause
createMissingTrXTrXClause :: QName
-> QName -> Arg Int -> BlockingVar -> SplitClause -> TCM Clause
createMissingTrXTrXClause QName
q_trX QName
f Arg Int
n BlockingVar
x SplitClause
old_sc = do
  let
   old_tel :: Tele (Dom Type)
old_tel = SplitClause -> Tele (Dom Type)
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

  [Char] -> Int -> TCMT IO Doc -> TCMT IO ()
forall (m :: * -> *).
MonadDebug m =>
[Char] -> Int -> TCMT IO Doc -> m ()
reportSDoc [Char]
"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
  [Char] -> Int -> TCMT IO Doc -> TCMT IO ()
forall (m :: * -> *).
MonadDebug m =>
[Char] -> Int -> TCMT IO Doc -> m ()
reportSDoc [Char]
"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
<+> Tele (Dom Type) -> TCMT IO Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
forall (m :: * -> *). MonadPretty m => Tele (Dom Type) -> m Doc
prettyTCM Tele (Dom Type)
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
<+> Tele (Dom Type) -> TCMT IO Doc -> TCMT IO Doc
forall b (m :: * -> *) a.
(AddContext b, MonadAddContext m) =>
b -> m a -> m a
forall (m :: * -> *) a.
MonadAddContext m =>
Tele (Dom Type) -> m a -> m a
addContext Tele (Dom Type)
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
<+> Tele (Dom Type) -> TCMT IO Doc -> TCMT IO Doc
forall b (m :: * -> *) a.
(AddContext b, MonadAddContext m) =>
b -> m a -> m a
forall (m :: * -> *) a.
MonadAddContext m =>
Tele (Dom Type) -> m a -> m a
addContext Tele (Dom Type)
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 -> Tele (Dom Type)
scTel SplitClause
old_sc
    old_ps' = [[Char]]
-> [NamedArg DeBruijnPattern] -> AbsN [NamedArg DeBruijnPattern]
forall a. [[Char]] -> a -> AbsN a
AbsN (Tele (Dom Type) -> [[Char]]
teleNames Tele (Dom Type)
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
$ [[Char]] -> Dom Type -> AbsN (Dom Type)
forall a. [[Char]] -> a -> AbsN a
AbsN (Tele (Dom Type) -> [[Char]]
teleNames Tele (Dom Type)
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 (Tele (Dom Type)) -> NamesT (TCMT IO) (AbsN (Tele (Dom Type)))
forall a. a -> NamesT (TCMT IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AbsN (Tele (Dom Type))
 -> NamesT (TCMT IO) (AbsN (Tele (Dom Type))))
-> AbsN (Tele (Dom Type))
-> NamesT (TCMT IO) (AbsN (Tele (Dom Type)))
forall a b. (a -> b) -> a -> b
$ [[Char]] -> Tele (Dom Type) -> AbsN (Tele (Dom Type))
forall a. [[Char]] -> a -> AbsN a
AbsN (Tele (Dom Type) -> [[Char]]
teleNames Tele (Dom Type)
gamma1x) (Tele (Dom Type) -> AbsN (Tele (Dom Type)))
-> Tele (Dom Type) -> AbsN (Tele (Dom Type))
forall a b. (a -> b) -> a -> b
$ Tele (Dom Type)
delta'
    gamma1_size = (Tele (Dom Type) -> Int
forall a. Sized a => a -> Int
size Tele (Dom Type)
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 -> [Arg Term] -> Term
forall t. Apply t => t -> [Arg Term] -> t
`apply` [Term -> Arg Term
forall e. e -> Arg e
argN Term
v],Term
l),(Term
v,Term
r)]) xs
  let
    gamma1ArgNames = Tele (Dom Type) -> [Arg [Char]]
teleArgNames Tele (Dom Type)
gamma1
    deltaArgNames = Tele (Dom Type) -> [Arg [Char]]
teleArgNames Tele (Dom Type)
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 = [[Char]] -> [Arg Term] -> AbsN [Arg Term]
forall a. [[Char]] -> a -> AbsN a
AbsN (Tele (Dom Type) -> [[Char]]
teleNames Tele (Dom Type)
gamma1) [Arg Term]
ps
        xTel = [[Char]] -> Tele (Dom Type) -> AbsN (Tele (Dom Type))
forall a. [[Char]] -> a -> AbsN a
AbsN (Tele (Dom Type) -> [[Char]]
teleNames Tele (Dom Type)
gamma1) (Tele (Dom Type)
tel Tele (Dom Type) -> [Arg Term] -> Tele (Dom Type)
forall t. Apply t => t -> [Arg Term] -> t
`apply` [Arg Term]
ps)

    dT <- runNamesT [] $ do
          s <- open $ AbsN (teleNames tel) s
          bindNArg (teleArgNames gamma1) $ \ ArgVars (TCMT IO)
g1 -> do
          [Arg [Char]]
-> (ArgVars (TCMT IO) -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) (AbsN Type)
forall (m :: * -> *) a.
Monad m =>
[Arg [Char]] -> (ArgVars m -> NamesT m a) -> NamesT m (AbsN a)
bindNArg (Tele (Dom Type) -> [Arg [Char]]
teleArgNames (Tele (Dom Type) -> [Arg [Char]])
-> Tele (Dom Type) -> [Arg [Char]]
forall a b. (a -> b) -> a -> b
$ AbsN (Tele (Dom Type)) -> Tele (Dom Type)
forall a. AbsN a -> a
unAbsN AbsN (Tele (Dom Type))
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 [Arg Term] -> NamesT (TCMT IO) (AbsN [Arg Term])
forall a. a -> NamesT (TCMT IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure AbsN [Arg Term]
params NamesT (TCMT IO) (AbsN [Arg Term])
-> [NamesT (TCMT IO) (SubstArg [Arg Term])]
-> NamesT (TCMT IO) [Arg Term]
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 (Tele (Dom Type)) -> NamesT (TCMT IO) (AbsN (Tele (Dom Type)))
forall a. a -> NamesT (TCMT IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AbsN (Tele (Dom Type))
 -> NamesT (TCMT IO) (AbsN (Tele (Dom Type))))
-> AbsN (Tele (Dom Type))
-> NamesT (TCMT IO) (AbsN (Tele (Dom Type)))
forall a b. (a -> b) -> a -> b
$ Type -> Tele (Dom Type) -> Tele (Dom Type)
expTelescope Type
interval (Tele (Dom Type) -> Tele (Dom Type))
-> AbsN (Tele (Dom Type)) -> AbsN (Tele (Dom Type))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AbsN (Tele (Dom Type))
xTel
    xTelIArgNames = Tele (Dom Type) -> [Arg [Char]]
teleArgNames (AbsN (Tele (Dom Type)) -> Tele (Dom Type)
forall a. AbsN a -> a
unAbsN AbsN (Tele (Dom Type))
xTel) -- same names

  -- Γ1, φ, p, ψ, q, x0 ⊢ pat := trX p φ (trX q ψ x0)
  let trX' = [Arg [Char]]
-> (ArgVars (TCMT IO)
    -> NamesT (TCMT IO) (AbsN (AbsN DeBruijnPattern)))
-> NamesT (TCMT IO) (AbsN (AbsN (AbsN DeBruijnPattern)))
forall (m :: * -> *) a.
Monad m =>
[Arg [Char]] -> (ArgVars m -> NamesT m a) -> NamesT m (AbsN a)
bindNArg [Arg [Char]]
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 [Char]]
-> (ArgVars (TCMT IO) -> NamesT (TCMT IO) (AbsN DeBruijnPattern))
-> NamesT (TCMT IO) (AbsN (AbsN DeBruijnPattern))
forall (m :: * -> *) a.
Monad m =>
[Arg [Char]] -> (ArgVars m -> NamesT m a) -> NamesT m (AbsN a)
bindNArg ([[Char] -> Arg [Char]
forall e. e -> Arg e
defaultArg [Char]
"phi"] [Arg [Char]] -> [Arg [Char]] -> [Arg [Char]]
forall a. [a] -> [a] -> [a]
++ [Arg [Char]]
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 [Char]]
-> (ArgVars (TCMT IO) -> NamesT (TCMT IO) DeBruijnPattern)
-> NamesT (TCMT IO) (AbsN DeBruijnPattern)
forall (m :: * -> *) a.
Monad m =>
[Arg [Char]] -> (ArgVars m -> NamesT m a) -> NamesT m (AbsN a)
bindNArg [[Char] -> Arg [Char]
forall e. e -> Arg e
defaultArg [Char]
"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 <- ([Arg Term] -> [NamedArg DeBruijnPattern])
-> NamesT (TCMT IO) [Arg Term]
-> 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)
-> [Arg Term] -> [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) [Arg Term]
 -> NamesT (TCMT IO) [NamedArg DeBruijnPattern])
-> NamesT (TCMT IO) [Arg Term]
-> NamesT (TCMT IO) [NamedArg DeBruijnPattern]
forall a b. (a -> b) -> a -> b
$
               AbsN [Arg Term] -> NamesT (TCMT IO) (AbsN [Arg Term])
forall a. a -> NamesT (TCMT IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure AbsN [Arg Term]
params NamesT (TCMT IO) (AbsN [Arg Term])
-> [NamesT (TCMT IO) (SubstArg [Arg Term])]
-> NamesT (TCMT IO) [Arg Term]
forall (m :: * -> *) a.
(Monad m, Subst a) =>
NamesT m (AbsN a) -> [NamesT m (SubstArg a)] -> NamesT m a
`applyN` ((Arg Term -> Term)
-> NamesT (TCMT IO) (Arg Term) -> NamesT (TCMT IO) Term
forall a b. (a -> b) -> NamesT (TCMT IO) a -> NamesT (TCMT IO) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Arg Term -> Term
forall e. Arg e -> e
unArg (NamesT (TCMT IO) (Arg Term) -> NamesT (TCMT IO) Term)
-> [NamesT (TCMT IO) (Arg Term)] -> [NamesT (TCMT IO) Term]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [NamesT (TCMT IO) (Arg Term)]
ArgVars (TCMT IO)
g1)
             (phi, p) <- fromMaybe __IMPOSSIBLE__ . uncons <$> sequence phi_p
             x0 <- sequence x0
             pure $ DefP defaultPatternInfo q_trX $ param_args ++ p ++ [phi] ++ x0
      trX = ((AbsN (AbsN DeBruijnPattern) -> AbsN (AbsN Term))
-> AbsN (AbsN (AbsN DeBruijnPattern)) -> AbsN (AbsN (AbsN Term))
forall a b. (a -> b) -> AbsN a -> AbsN b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((AbsN (AbsN DeBruijnPattern) -> AbsN (AbsN Term))
 -> AbsN (AbsN (AbsN DeBruijnPattern)) -> AbsN (AbsN (AbsN Term)))
-> ((DeBruijnPattern -> Term)
    -> AbsN (AbsN DeBruijnPattern) -> AbsN (AbsN Term))
-> (DeBruijnPattern -> Term)
-> AbsN (AbsN (AbsN DeBruijnPattern))
-> AbsN (AbsN (AbsN Term))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AbsN DeBruijnPattern -> AbsN Term)
-> AbsN (AbsN DeBruijnPattern) -> AbsN (AbsN Term)
forall a b. (a -> b) -> AbsN a -> AbsN b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((AbsN DeBruijnPattern -> AbsN Term)
 -> AbsN (AbsN DeBruijnPattern) -> AbsN (AbsN Term))
-> ((DeBruijnPattern -> Term) -> AbsN DeBruijnPattern -> AbsN Term)
-> (DeBruijnPattern -> Term)
-> AbsN (AbsN DeBruijnPattern)
-> AbsN (AbsN Term)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DeBruijnPattern -> Term) -> AbsN DeBruijnPattern -> AbsN Term
forall a b. (a -> b) -> AbsN a -> AbsN b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) DeBruijnPattern -> Term
patternToTerm (AbsN (AbsN (AbsN DeBruijnPattern)) -> AbsN (AbsN (AbsN Term)))
-> NamesT (TCMT IO) (AbsN (AbsN (AbsN DeBruijnPattern)))
-> NamesT (TCMT IO) (AbsN (AbsN (AbsN Term)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamesT (TCMT IO) (AbsN (AbsN (AbsN DeBruijnPattern)))
trX'
  let pat' =
            [[Char]]
-> (Vars (TCMT IO)
    -> NamesT (TCMT IO) (AbsN (AbsN (AbsN DeBruijnPattern))))
-> NamesT (TCMT IO) (AbsN (AbsN (AbsN (AbsN DeBruijnPattern))))
forall (m :: * -> *) a.
Monad m =>
[[Char]] -> (Vars m -> NamesT m a) -> NamesT m (AbsN a)
bindN ((Arg [Char] -> [Char]) -> [Arg [Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map Arg [Char] -> [Char]
forall e. Arg e -> e
unArg [Arg [Char]]
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
            [[Char]]
-> (Vars (TCMT IO)
    -> NamesT (TCMT IO) (AbsN (AbsN DeBruijnPattern)))
-> NamesT (TCMT IO) (AbsN (AbsN (AbsN DeBruijnPattern)))
forall (m :: * -> *) a.
Monad m =>
[[Char]] -> (Vars m -> NamesT m a) -> NamesT m (AbsN a)
bindN ((Arg [Char] -> [Char]) -> [Arg [Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map Arg [Char] -> [Char]
forall e. Arg e -> e
unArg ([Arg [Char]] -> [[Char]]) -> [Arg [Char]] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ ([[Char] -> Arg [Char]
forall e. e -> Arg e
defaultArg [Char]
"phi"] [Arg [Char]] -> [Arg [Char]] -> [Arg [Char]]
forall a. [a] -> [a] -> [a]
++ [Arg [Char]]
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
            [[Char]]
-> (Vars (TCMT IO) -> NamesT (TCMT IO) (AbsN DeBruijnPattern))
-> NamesT (TCMT IO) (AbsN (AbsN DeBruijnPattern))
forall (m :: * -> *) a.
Monad m =>
[[Char]] -> (Vars m -> NamesT m a) -> NamesT m (AbsN a)
bindN ((Arg [Char] -> [Char]) -> [Arg [Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map Arg [Char] -> [Char]
forall e. Arg e -> e
unArg ([Arg [Char]] -> [[Char]]) -> [Arg [Char]] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ ([[Char] -> Arg [Char]
forall e. e -> Arg e
defaultArg [Char]
"psi"] [Arg [Char]] -> [Arg [Char]] -> [Arg [Char]]
forall a. [a] -> [a] -> [a]
++ [Arg [Char]]
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
            [[Char]]
-> (Vars (TCMT IO) -> NamesT (TCMT IO) DeBruijnPattern)
-> NamesT (TCMT IO) (AbsN DeBruijnPattern)
forall (m :: * -> *) a.
Monad m =>
[[Char]] -> (Vars m -> NamesT m a) -> NamesT m (AbsN a)
bindN ((Arg [Char] -> [Char]) -> [Arg [Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map Arg [Char] -> [Char]
forall e. Arg e -> e
unArg ([Arg [Char]] -> [[Char]]) -> [Arg [Char]] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ [[Char] -> Arg [Char]
forall e. e -> Arg e
defaultArg [Char]
"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 (Tele (Dom Type)))
delta NamesT (TCMT IO) (AbsN (Tele (Dom Type)))
-> [NamesT (TCMT IO) (SubstArg (Tele (Dom Type)))]
-> NamesT (TCMT IO) (Tele (Dom Type))
forall (m :: * -> *) a.
(Monad m, Subst a) =>
NamesT m (AbsN a) -> [NamesT m (SubstArg a)] -> NamesT m a
`applyN` ([NamesT (TCMT IO) Term]
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
    [Char]
-> NamesT (TCMT IO) Type
-> (Var (TCMT IO) -> NamesT (TCMT IO) (Tele (Dom Type)))
-> NamesT (TCMT IO) (Tele (Dom Type))
forall (m :: * -> *) a.
(Monad m, Abstract a) =>
[Char] -> NamesT m Type -> (Var m -> NamesT m a) -> NamesT m a
abstractT [Char]
"φ" (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) (Tele (Dom Type)))
 -> NamesT (TCMT IO) (Tele (Dom Type)))
-> (Var (TCMT IO) -> NamesT (TCMT IO) (Tele (Dom Type)))
-> NamesT (TCMT IO) (Tele (Dom Type))
forall a b. (a -> b) -> a -> b
$ \ Var (TCMT IO)
phi -> do
    NamesT (TCMT IO) (Tele (Dom Type))
-> (Vars (TCMT IO) -> NamesT (TCMT IO) (Tele (Dom Type)))
-> NamesT (TCMT IO) (Tele (Dom Type))
forall (m :: * -> *) a.
(Monad m, Abstract a) =>
NamesT m (Tele (Dom Type)) -> (Vars m -> NamesT m a) -> NamesT m a
abstractN (NamesT (TCMT IO) (AbsN (Tele (Dom Type)))
xTelI NamesT (TCMT IO) (AbsN (Tele (Dom Type)))
-> [NamesT (TCMT IO) (SubstArg (Tele (Dom Type)))]
-> NamesT (TCMT IO) (Tele (Dom Type))
forall (m :: * -> *) a.
(Monad m, Subst a) =>
NamesT m (AbsN a) -> [NamesT m (SubstArg a)] -> NamesT m a
`applyN` [NamesT (TCMT IO) Term]
[NamesT (TCMT IO) (SubstArg (Tele (Dom Type)))]
Vars (TCMT IO)
g1) ((Vars (TCMT IO) -> NamesT (TCMT IO) (Tele (Dom Type)))
 -> NamesT (TCMT IO) (Tele (Dom Type)))
-> (Vars (TCMT IO) -> NamesT (TCMT IO) (Tele (Dom Type)))
-> NamesT (TCMT IO) (Tele (Dom Type))
forall a b. (a -> b) -> a -> b
$ \ Vars (TCMT IO)
p -> do
    [Char]
-> NamesT (TCMT IO) Type
-> (Var (TCMT IO) -> NamesT (TCMT IO) (Tele (Dom Type)))
-> NamesT (TCMT IO) (Tele (Dom Type))
forall (m :: * -> *) a.
(Monad m, Abstract a) =>
[Char] -> NamesT m Type -> (Var m -> NamesT m a) -> NamesT m a
abstractT [Char]
"ψ" (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) (Tele (Dom Type)))
 -> NamesT (TCMT IO) (Tele (Dom Type)))
-> (Var (TCMT IO) -> NamesT (TCMT IO) (Tele (Dom Type)))
-> NamesT (TCMT IO) (Tele (Dom Type))
forall a b. (a -> b) -> a -> b
$ \ Var (TCMT IO)
psi -> do
    NamesT (TCMT IO) (Tele (Dom Type))
-> (Vars (TCMT IO) -> NamesT (TCMT IO) (Tele (Dom Type)))
-> NamesT (TCMT IO) (Tele (Dom Type))
forall (m :: * -> *) a.
(Monad m, Abstract a) =>
NamesT m (Tele (Dom Type)) -> (Vars m -> NamesT m a) -> NamesT m a
abstractN (NamesT (TCMT IO) (AbsN (Tele (Dom Type)))
xTelI NamesT (TCMT IO) (AbsN (Tele (Dom Type)))
-> [NamesT (TCMT IO) (SubstArg (Tele (Dom Type)))]
-> NamesT (TCMT IO) (Tele (Dom Type))
forall (m :: * -> *) a.
(Monad m, Subst a) =>
NamesT m (AbsN a) -> [NamesT m (SubstArg a)] -> NamesT m a
`applyN` [NamesT (TCMT IO) Term]
[NamesT (TCMT IO) (SubstArg (Tele (Dom Type)))]
Vars (TCMT IO)
g1) ((Vars (TCMT IO) -> NamesT (TCMT IO) (Tele (Dom Type)))
 -> NamesT (TCMT IO) (Tele (Dom Type)))
-> (Vars (TCMT IO) -> NamesT (TCMT IO) (Tele (Dom Type)))
-> NamesT (TCMT IO) (Tele (Dom Type))
forall a b. (a -> b) -> a -> b
$ \ Vars (TCMT IO)
q -> do
    [Char]
-> NamesT (TCMT IO) Type
-> (Var (TCMT IO) -> NamesT (TCMT IO) (Tele (Dom Type)))
-> NamesT (TCMT IO) (Tele (Dom Type))
forall (m :: * -> *) a.
(Monad m, Abstract a) =>
[Char] -> NamesT m Type -> (Var m -> NamesT m a) -> NamesT m a
abstractT [Char]
"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) (Tele (Dom Type)))
 -> NamesT (TCMT IO) (Tele (Dom Type)))
-> (Var (TCMT IO) -> NamesT (TCMT IO) (Tele (Dom Type)))
-> NamesT (TCMT IO) (Tele (Dom Type))
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) (Tele (Dom Type))
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
    [Char]
-> (Var (TCMT IO)
    -> NamesT
         (TCMT IO)
         (AbsN
            (Abs
               (AbsN (Abs (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term)))))))
-> NamesT
     (TCMT IO)
     (Abs
        (AbsN
           (Abs
              (AbsN (Abs (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term)))))))
forall (m :: * -> *) a.
Monad m =>
[Char]
-> ((forall b. (Subst b, DeBruijn b) => NamesT m b) -> NamesT m a)
-> NamesT m (Abs a)
bind [Char]
"φ" ((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
    [[Char]]
-> (Vars (TCMT IO)
    -> NamesT
         (TCMT IO)
         (Abs
            (AbsN (Abs (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term))))))
-> NamesT
     (TCMT IO)
     (AbsN
        (Abs
           (AbsN (Abs (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term))))))
forall (m :: * -> *) a.
Monad m =>
[[Char]] -> (Vars m -> NamesT m a) -> NamesT m (AbsN a)
bindN ((Arg [Char] -> [Char]) -> [Arg [Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map Arg [Char] -> [Char]
forall e. Arg e -> e
unArg [Arg [Char]]
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
    [Char]
-> (Var (TCMT IO)
    -> NamesT
         (TCMT IO)
         (AbsN (Abs (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term)))))
-> NamesT
     (TCMT IO)
     (Abs
        (AbsN (Abs (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term)))))
forall (m :: * -> *) a.
Monad m =>
[Char]
-> ((forall b. (Subst b, DeBruijn b) => NamesT m b) -> NamesT m a)
-> NamesT m (Abs a)
bind [Char]
"ψ" ((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
    [[Char]]
-> (Vars (TCMT IO)
    -> NamesT
         (TCMT IO)
         (Abs (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term))))
-> NamesT
     (TCMT IO)
     (AbsN (Abs (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term))))
forall (m :: * -> *) a.
Monad m =>
[[Char]] -> (Vars m -> NamesT m a) -> NamesT m (AbsN a)
bindN ((Arg [Char] -> [Char]) -> [Arg [Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map Arg [Char] -> [Char]
forall e. Arg e -> e
unArg [Arg [Char]]
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
    [Char]
-> (Var (TCMT IO)
    -> NamesT
         (TCMT IO) (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term)))
-> NamesT
     (TCMT IO) (Abs (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term)))
forall (m :: * -> *) a.
Monad m =>
[Char]
-> ((forall b. (Subst b, DeBruijn b) => NamesT m b) -> NamesT m a)
-> NamesT m (Abs a)
bind [Char]
"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
    [[Char]]
-> (Vars (TCMT IO)
    -> NamesT (TCMT IO) ([NamedArg DeBruijnPattern], Dom Type, Term))
-> NamesT
     (TCMT IO) (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term))
forall (m :: * -> *) a.
Monad m =>
[[Char]] -> (Vars m -> NamesT m a) -> NamesT m (AbsN a)
bindN ((Arg [Char] -> [Char]) -> [Arg [Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map Arg [Char] -> [Char]
forall e. Arg e -> e
unArg [Arg [Char]]
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 <- (Tele (Dom Type)
-> NamesT (TCMT IO) (NamesT (TCMT IO) (Tele (Dom Type)))
forall (m :: * -> *) a.
(Monad m, Subst a) =>
a -> NamesT m (NamesT m a)
open (Tele (Dom Type)
 -> NamesT (TCMT IO) (NamesT (TCMT IO) (Tele (Dom Type))))
-> NamesT (TCMT IO) (Tele (Dom Type))
-> NamesT (TCMT IO) (NamesT (TCMT IO) (Tele (Dom Type)))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (NamesT (TCMT IO) (Tele (Dom Type))
 -> NamesT (TCMT IO) (NamesT (TCMT IO) (Tele (Dom Type))))
-> NamesT (TCMT IO) (Tele (Dom Type))
-> NamesT (TCMT IO) (NamesT (TCMT IO) (Tele (Dom Type)))
forall a b. (a -> b) -> a -> b
$ AbsN (Tele (Dom Type)) -> NamesT (TCMT IO) (AbsN (Tele (Dom Type)))
forall a. a -> NamesT (TCMT IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure AbsN (Tele (Dom Type))
xTel NamesT (TCMT IO) (AbsN (Tele (Dom Type)))
-> [NamesT (TCMT IO) (SubstArg (Tele (Dom Type)))]
-> NamesT (TCMT IO) (Tele (Dom Type))
forall (m :: * -> *) a.
(Monad m, Subst a) =>
NamesT m (AbsN a) -> [NamesT m (SubstArg a)] -> NamesT m a
`applyN` [NamesT (TCMT IO) Term]
[NamesT (TCMT IO) (SubstArg (Tele (Dom Type)))]
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
$ [Char]
-> (Var (TCMT IO) -> NamesT (TCMT IO) [Term])
-> NamesT (TCMT IO) (Abs [Term])
forall (m :: * -> *) a.
Monad m =>
[Char]
-> ((forall b. (Subst b, DeBruijn b) => NamesT m b) -> NamesT m a)
-> NamesT m (Abs a)
bind [Char]
"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 <- [Char]
-> (Var (TCMT IO) -> NamesT (TCMT IO) (Tele (Dom Type)))
-> NamesT (TCMT IO) (Abs (Tele (Dom Type)))
forall (m :: * -> *) a.
Monad m =>
[Char]
-> ((forall b. (Subst b, DeBruijn b) => NamesT m b) -> NamesT m a)
-> NamesT m (Abs a)
bind [Char]
"i" ((Var (TCMT IO) -> NamesT (TCMT IO) (Tele (Dom Type)))
 -> NamesT (TCMT IO) (Abs (Tele (Dom Type))))
-> (Var (TCMT IO) -> NamesT (TCMT IO) (Tele (Dom Type)))
-> NamesT (TCMT IO) (Abs (Tele (Dom Type)))
forall a b. (a -> b) -> a -> b
$ \ Var (TCMT IO)
_ -> NamesT (TCMT IO) (Tele (Dom Type))
xTel
      face <- max phi $ max (neg j) (neg i)
      base <- map defaultArg <$> appTel (sequence q) j
      u  <- liftM2 (,) (max j psi) $ bind "h" $ \ Var (TCMT IO)
h -> do
              NamesT (TCMT IO) [Term]
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) [Term]
forall (m :: * -> *).
Monad m =>
NamesT m [Term] -> NamesT m Term -> NamesT m [Term]
appTel ([NamesT (TCMT IO) Term] -> NamesT (TCMT IO) [Term]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence [NamesT (TCMT IO) Term]
Vars (TCMT IO)
p) (NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall {m :: * -> *}.
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
NamesT m Term -> NamesT m Term -> NamesT m Term
min NamesT (TCMT IO) Term
Var (TCMT IO)
j (NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall {m :: * -> *}.
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
NamesT m Term -> NamesT m Term -> NamesT m Term
min NamesT (TCMT IO) Term
Var (TCMT IO)
h NamesT (TCMT IO) Term
Var (TCMT IO)
i))
      xs <- fromRight __IMPOSSIBLE__ <$> do lift $ runExceptT $ transpSysTel' False ty [u] face base
      pure $ map unArg xs
    -- Ξ ⊢ pat_rec[0] = pat : D η v
    -- Ξ ⊢ pat_rec[1] = trX q4 (φ ∧ ψ) x0 : D η v
    -- Ξ ⊢ pat-rec[i] := trX (\ j → p (i ∨ j)) (i ∨ φ) (trX (q4_f i) (ψ ∧ (φ ∨ ~ i)) t)
    pat_rec <- (open =<<) $ bind "i" $ \ Var (TCMT IO)
i -> do
          p_conn <- ((Term -> NamesT (TCMT IO) (NamesT (TCMT IO) Term))
-> [Term] -> NamesT (TCMT IO) [NamesT (TCMT IO) Term]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Term -> NamesT (TCMT IO) (NamesT (TCMT IO) Term)
forall (m :: * -> *) a.
(Monad m, Subst a) =>
a -> NamesT m (NamesT m a)
open ([Term] -> NamesT (TCMT IO) [NamesT (TCMT IO) Term])
-> NamesT (TCMT IO) [Term]
-> NamesT (TCMT IO) [NamesT (TCMT IO) Term]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (NamesT (TCMT IO) [Term]
 -> NamesT (TCMT IO) [NamesT (TCMT IO) Term])
-> NamesT (TCMT IO) [Term]
-> NamesT (TCMT IO) [NamesT (TCMT IO) Term]
forall a b. (a -> b) -> a -> b
$ NamesT (TCMT IO) (Abs [Term]) -> NamesT (TCMT IO) [Term]
forall (m :: * -> *).
Monad m =>
NamesT m (Abs [Term]) -> NamesT m [Term]
lamTel (NamesT (TCMT IO) (Abs [Term]) -> NamesT (TCMT IO) [Term])
-> NamesT (TCMT IO) (Abs [Term]) -> NamesT (TCMT IO) [Term]
forall a b. (a -> b) -> a -> b
$ [Char]
-> (Var (TCMT IO) -> NamesT (TCMT IO) [Term])
-> NamesT (TCMT IO) (Abs [Term])
forall (m :: * -> *) a.
Monad m =>
[Char]
-> ((forall b. (Subst b, DeBruijn b) => NamesT m b) -> NamesT m a)
-> NamesT m (Abs a)
bind [Char]
"i" ((Var (TCMT IO) -> NamesT (TCMT IO) [Term])
 -> NamesT (TCMT IO) (Abs [Term]))
-> (Var (TCMT IO) -> NamesT (TCMT IO) [Term])
-> NamesT (TCMT IO) (Abs [Term])
forall a b. (a -> b) -> a -> b
$ \ Var (TCMT IO)
j -> [NamesT (TCMT IO) Term] -> NamesT (TCMT IO) [Term]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence [NamesT (TCMT IO) Term]
Vars (TCMT IO)
p NamesT (TCMT IO) [Term]
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) [Term]
forall (m :: * -> *).
Monad m =>
NamesT m [Term] -> NamesT m Term -> NamesT m [Term]
`appTel` NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall {m :: * -> *}.
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
NamesT m Term -> NamesT m Term -> NamesT m Term
max NamesT (TCMT IO) Term
Var (TCMT IO)
i NamesT (TCMT IO) Term
Var (TCMT IO)
j
          q4_f' <- (mapM open =<<) $ absApp <$> q4_f <*> i
          trX `applyN` g1 `applyN` (max i phi:p_conn)
              `applyN` [trX `applyN` g1 `applyN` (min psi (max phi (neg i)):q4_f') `applyN` [x0]]

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

    -- Ξ ⊢ δ_f[1] = tr (i. Δ[γ1,x = pat_rec[i]]) (φ ∧ ψ) δ
    -- Ξ ⊢ w0 := f old_ps[γ1,x = pat_rec[1] ,δ_f[1]] : old_t[γ1,x = pat_rec[1],δ_f[1]]
    -- Ξ ⊢ rhs := tr (i. old_t[γ1,x = pat_rec[~i], δ_f[~i]]) (φ ∧ ψ) w0 -- TODO plus sides.
    syspsi <- (open =<<) $ lam "i" $ \ NamesT (TCMT IO) Term
i -> [Char]
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall (m :: * -> *).
Monad m =>
[Char] -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
ilam [Char]
"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
$ [[Char]]
-> (Vars (TCMT IO) -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) (AbsN Term)
forall (m :: * -> *) a.
Monad m =>
[[Char]] -> (Vars m -> NamesT m a) -> NamesT m (AbsN a)
bindN [[Char]
"i",[Char]
"j"] ((Vars (TCMT IO) -> NamesT (TCMT IO) Term)
 -> NamesT (TCMT IO) (AbsN Term))
-> (Vars (TCMT IO) -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) (AbsN Term)
forall a b. (a -> b) -> a -> b
$ \ [NamesT (TCMT IO) Term
i,NamesT (TCMT IO) Term
j] -> do
        res <- [Char]
-> (Var (TCMT IO) -> NamesT (TCMT IO) (Type, [Term]))
-> NamesT (TCMT IO) (Abs (Type, [Term]))
forall (m :: * -> *) a.
Monad m =>
[Char]
-> ((forall b. (Subst b, DeBruijn b) => NamesT m b) -> NamesT m a)
-> NamesT m (Abs a)
bind [Char]
"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 -> [Char]
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall (m :: * -> *).
Monad m =>
[Char] -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
lam [Char]
"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 -> [Char]
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall (m :: * -> *).
Monad m =>
[Char] -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
lam [Char]
"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 -> [Char]
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall (m :: * -> *).
Monad m =>
[Char] -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
lam [Char]
"h" ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
 -> NamesT (TCMT IO) Term)
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall a b. (a -> b) -> a -> b
$ \ NamesT (TCMT IO) Term
h -> NamesT (TCMT IO) Term
p NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> (NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall {m :: * -> *}.
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
NamesT m Term -> NamesT m Term -> NamesT m Term
min NamesT (TCMT IO) Term
h NamesT (TCMT IO) Term
j)))
                       `applyN` [x0]]
          pure (data_ty, [line1, line2])
        case res of
          Abs [Char]
n (Type
data_ty, [Term
line1, Term
line2]) -> do
            data_ty <- Abs Type -> NamesT (TCMT IO) (NamesT (TCMT IO) (Abs Type))
forall (m :: * -> *) a.
(Monad m, Subst a) =>
a -> NamesT m (NamesT m a)
open (Abs Type -> NamesT (TCMT IO) (NamesT (TCMT IO) (Abs Type)))
-> Abs Type -> NamesT (TCMT IO) (NamesT (TCMT IO) (Abs Type))
forall a b. (a -> b) -> a -> b
$ [Char] -> Type -> Abs Type
forall a. [Char] -> a -> Abs a
Abs [Char]
n Type
data_ty
            line1   <- open $ Abs n line1
            line2   <- open $ Abs n line2
            let sys = [(NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
neg NamesT (TCMT IO) Term
i, [Char]
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall (m :: * -> *).
Monad m =>
[Char] -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
lam [Char]
"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 -> [Char]
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall (m :: * -> *).
Monad m =>
[Char] -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
ilam [Char]
"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, [Char]
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall (m :: * -> *).
Monad m =>
[Char] -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
lam [Char]
"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 -> [Char]
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall (m :: * -> *).
Monad m =>
[Char] -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
ilam [Char]
"o" ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
 -> NamesT (TCMT IO) Term)
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall a b. (a -> b) -> a -> b
$ \ NamesT (TCMT IO) Term
_ -> Abs Term -> Term -> Term
Abs Term -> SubstArg Term -> Term
forall a. Subst a => Abs a -> SubstArg a -> a
absApp (Abs Term -> Term -> Term)
-> NamesT (TCMT IO) (Abs Term) -> NamesT (TCMT IO) (Term -> Term)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamesT (TCMT IO) (Abs Term)
line1 NamesT (TCMT IO) (Term -> Term)
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall a b.
NamesT (TCMT IO) (a -> b)
-> NamesT (TCMT IO) a -> NamesT (TCMT IO) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> NamesT (TCMT IO) Term
k)
                      ]
            transpSys data_ty sys (pure iz) x0
          Abs (Type, [Term])
_ -> NamesT (TCMT IO) Term
forall a. HasCallStack => a
__IMPOSSIBLE__
      absApp <$> pure c <*> i
    sysphi <- (open =<<) $ lam "i" $ \ NamesT (TCMT IO) Term
i -> [Char]
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall (m :: * -> *).
Monad m =>
[Char] -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
ilam [Char]
"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
$ [[Char]]
-> (Vars (TCMT IO) -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) (AbsN Term)
forall (m :: * -> *) a.
Monad m =>
[[Char]] -> (Vars m -> NamesT m a) -> NamesT m (AbsN a)
bindN [[Char]
"i",[Char]
"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 ([[Char]]
-> (Vars (TCMT IO) -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) (AbsN Term)
forall (m :: * -> *) a.
Monad m =>
[[Char]] -> (Vars m -> NamesT m a) -> NamesT m (AbsN a)
bindN [[Char]
"i",[Char]
"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) =>
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 :: Tele (Dom Type)
clauseTel       = Tele (Dom Type)
cTel
                 , namedClausePats :: [NamedArg DeBruijnPattern]
namedClausePats = [NamedArg DeBruijnPattern]
ps
                 , clauseBody :: Maybe Term
clauseBody      = Term -> Maybe Term
forall a. a -> Maybe a
Just Term
rhs
                 , clauseType :: Maybe (Arg Type)
clauseType      = Arg Type -> Maybe (Arg Type)
forall a. a -> Maybe a
Just (Arg Type -> Maybe (Arg Type)) -> Arg Type -> Maybe (Arg Type)
forall a b. (a -> b) -> a -> b
$ ArgInfo -> Type -> Arg Type
forall e. ArgInfo -> e -> Arg e
Arg (Dom Type -> ArgInfo
forall a. LensArgInfo a => a -> ArgInfo
getArgInfo Dom Type
ty) (Dom Type -> Type
forall t e. Dom' t e -> e
unDom Dom Type
ty)
                 , clauseCatchall :: Catchall
clauseCatchall    = Catchall
forall a. Null a => a
empty
                 , clauseRecursive :: ClauseRecursive
clauseRecursive   = ClauseRecursive
YesRecursive
                 , clauseUnreachable :: Maybe Bool
clauseUnreachable = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False
                 , clauseEllipsis :: ExpandedEllipsis
clauseEllipsis    = ExpandedEllipsis
NoEllipsis
                 , clauseWhereModule :: Maybe ModuleName
clauseWhereModule = Maybe ModuleName
forall a. Maybe a
Nothing
                 }
  debugClause "tc.cover.trx.trx" c
  return $ c

createMissingTrXHCompClause ::
     QName
  -> QName
  -> Arg Nat
  -> BlockingVar
  -> SplitClause
  -> TCM Clause
createMissingTrXHCompClause :: QName
-> QName -> Arg Int -> BlockingVar -> SplitClause -> TCM Clause
createMissingTrXHCompClause QName
q_trX QName
f Arg Int
n BlockingVar
x SplitClause
old_sc = do
  let
   old_tel :: Tele (Dom Type)
old_tel = SplitClause -> Tele (Dom Type)
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

  [Char] -> Int -> TCMT IO Doc -> TCMT IO ()
forall (m :: * -> *).
MonadDebug m =>
[Char] -> Int -> TCMT IO Doc -> m ()
reportSDoc [Char]
"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
  [Char] -> Int -> TCMT IO Doc -> TCMT IO ()
forall (m :: * -> *).
MonadDebug m =>
[Char] -> Int -> TCMT IO Doc -> m ()
reportSDoc [Char]
"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
<+> Tele (Dom Type) -> TCMT IO Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
forall (m :: * -> *). MonadPretty m => Tele (Dom Type) -> m Doc
prettyTCM Tele (Dom Type)
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
<+> Tele (Dom Type) -> TCMT IO Doc -> TCMT IO Doc
forall b (m :: * -> *) a.
(AddContext b, MonadAddContext m) =>
b -> m a -> m a
forall (m :: * -> *) a.
MonadAddContext m =>
Tele (Dom Type) -> m a -> m a
addContext Tele (Dom Type)
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
<+> Tele (Dom Type) -> TCMT IO Doc -> TCMT IO Doc
forall b (m :: * -> *) a.
(AddContext b, MonadAddContext m) =>
b -> m a -> m a
forall (m :: * -> *) a.
MonadAddContext m =>
Tele (Dom Type) -> m a -> m a
addContext Tele (Dom Type)
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 -> Tele (Dom Type)
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 -> Tele (Dom Type)
scTel SplitClause
old_sc
    old_ps' = [[Char]]
-> [NamedArg DeBruijnPattern] -> AbsN [NamedArg DeBruijnPattern]
forall a. [[Char]] -> a -> AbsN a
AbsN (Tele (Dom Type) -> [[Char]]
teleNames Tele (Dom Type)
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
$ [[Char]] -> Dom Type -> AbsN (Dom Type)
forall a. [[Char]] -> a -> AbsN a
AbsN (Tele (Dom Type) -> [[Char]]
teleNames Tele (Dom Type)
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 (Tele (Dom Type)) -> NamesT (TCMT IO) (AbsN (Tele (Dom Type)))
forall a. a -> NamesT (TCMT IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AbsN (Tele (Dom Type))
 -> NamesT (TCMT IO) (AbsN (Tele (Dom Type))))
-> AbsN (Tele (Dom Type))
-> NamesT (TCMT IO) (AbsN (Tele (Dom Type)))
forall a b. (a -> b) -> a -> b
$ [[Char]] -> Tele (Dom Type) -> AbsN (Tele (Dom Type))
forall a. [[Char]] -> a -> AbsN a
AbsN (Tele (Dom Type) -> [[Char]]
teleNames Tele (Dom Type)
gamma1x) (Tele (Dom Type) -> AbsN (Tele (Dom Type)))
-> Tele (Dom Type) -> AbsN (Tele (Dom Type))
forall a b. (a -> b) -> a -> b
$ Tele (Dom Type)
delta'
    gamma1_size = (Tele (Dom Type) -> Int
forall a. Sized a => a -> Int
size Tele (Dom Type)
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 -> [Arg Term] -> Term
forall t. Apply t => t -> [Arg Term] -> t
`apply` [Term -> Arg Term
forall e. e -> Arg e
argN Term
v],Term
l),(Term
v,Term
r)]) xs
  let
    gamma1ArgNames = Tele (Dom Type) -> [Arg [Char]]
teleArgNames Tele (Dom Type)
gamma1
    deltaArgNames = Tele (Dom Type) -> [Arg [Char]]
teleArgNames Tele (Dom Type)
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 = [[Char]] -> [Arg Term] -> AbsN [Arg Term]
forall a. [[Char]] -> a -> AbsN a
AbsN (Tele (Dom Type) -> [[Char]]
teleNames Tele (Dom Type)
gamma1) [Arg Term]
ps
        xTel = [[Char]] -> Tele (Dom Type) -> AbsN (Tele (Dom Type))
forall a. [[Char]] -> a -> AbsN a
AbsN (Tele (Dom Type) -> [[Char]]
teleNames Tele (Dom Type)
gamma1) (Tele (Dom Type)
tel Tele (Dom Type) -> [Arg Term] -> Tele (Dom Type)
forall t. Apply t => t -> [Arg Term] -> t
`apply` [Arg Term]
ps)

    dT <- runNamesT [] $ do
          s <- open $ AbsN (teleNames tel) s
          bindNArg (teleArgNames gamma1) $ \ ArgVars (TCMT IO)
g1 -> do
          [Arg [Char]]
-> (ArgVars (TCMT IO) -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) (AbsN Type)
forall (m :: * -> *) a.
Monad m =>
[Arg [Char]] -> (ArgVars m -> NamesT m a) -> NamesT m (AbsN a)
bindNArg (Tele (Dom Type) -> [Arg [Char]]
teleArgNames (Tele (Dom Type) -> [Arg [Char]])
-> Tele (Dom Type) -> [Arg [Char]]
forall a b. (a -> b) -> a -> b
$ AbsN (Tele (Dom Type)) -> Tele (Dom Type)
forall a. AbsN a -> a
unAbsN AbsN (Tele (Dom Type))
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 [Arg Term] -> NamesT (TCMT IO) (AbsN [Arg Term])
forall a. a -> NamesT (TCMT IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure AbsN [Arg Term]
params NamesT (TCMT IO) (AbsN [Arg Term])
-> [NamesT (TCMT IO) (SubstArg [Arg Term])]
-> NamesT (TCMT IO) [Arg Term]
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 (Tele (Dom Type)) -> NamesT (TCMT IO) (AbsN (Tele (Dom Type)))
forall a. a -> NamesT (TCMT IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AbsN (Tele (Dom Type))
 -> NamesT (TCMT IO) (AbsN (Tele (Dom Type))))
-> AbsN (Tele (Dom Type))
-> NamesT (TCMT IO) (AbsN (Tele (Dom Type)))
forall a b. (a -> b) -> a -> b
$ Type -> Tele (Dom Type) -> Tele (Dom Type)
expTelescope Type
interval (Tele (Dom Type) -> Tele (Dom Type))
-> AbsN (Tele (Dom Type)) -> AbsN (Tele (Dom Type))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AbsN (Tele (Dom Type))
xTel
    xTelIArgNames = Tele (Dom Type) -> [Arg [Char]]
teleArgNames (AbsN (Tele (Dom Type)) -> Tele (Dom Type)
forall a. AbsN a -> a
unAbsN AbsN (Tele (Dom Type))
xTel) -- same names

  -- Γ1, φ, p, ψ, q, x0 ⊢ pat := trX p φ (trX q ψ x0)
  let trX' = [Arg [Char]]
-> (ArgVars (TCMT IO)
    -> NamesT (TCMT IO) (AbsN (AbsN DeBruijnPattern)))
-> NamesT (TCMT IO) (AbsN (AbsN (AbsN DeBruijnPattern)))
forall (m :: * -> *) a.
Monad m =>
[Arg [Char]] -> (ArgVars m -> NamesT m a) -> NamesT m (AbsN a)
bindNArg [Arg [Char]]
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 [Char]]
-> (ArgVars (TCMT IO) -> NamesT (TCMT IO) (AbsN DeBruijnPattern))
-> NamesT (TCMT IO) (AbsN (AbsN DeBruijnPattern))
forall (m :: * -> *) a.
Monad m =>
[Arg [Char]] -> (ArgVars m -> NamesT m a) -> NamesT m (AbsN a)
bindNArg ([[Char] -> Arg [Char]
forall e. e -> Arg e
defaultArg [Char]
"phi"] [Arg [Char]] -> [Arg [Char]] -> [Arg [Char]]
forall a. [a] -> [a] -> [a]
++ [Arg [Char]]
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 [Char]]
-> (ArgVars (TCMT IO) -> NamesT (TCMT IO) DeBruijnPattern)
-> NamesT (TCMT IO) (AbsN DeBruijnPattern)
forall (m :: * -> *) a.
Monad m =>
[Arg [Char]] -> (ArgVars m -> NamesT m a) -> NamesT m (AbsN a)
bindNArg [[Char] -> Arg [Char]
forall e. e -> Arg e
defaultArg [Char]
"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 <- ([Arg Term] -> [NamedArg DeBruijnPattern])
-> NamesT (TCMT IO) [Arg Term]
-> 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)
-> [Arg Term] -> [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) [Arg Term]
 -> NamesT (TCMT IO) [NamedArg DeBruijnPattern])
-> NamesT (TCMT IO) [Arg Term]
-> NamesT (TCMT IO) [NamedArg DeBruijnPattern]
forall a b. (a -> b) -> a -> b
$
               AbsN [Arg Term] -> NamesT (TCMT IO) (AbsN [Arg Term])
forall a. a -> NamesT (TCMT IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure AbsN [Arg Term]
params NamesT (TCMT IO) (AbsN [Arg Term])
-> [NamesT (TCMT IO) (SubstArg [Arg Term])]
-> NamesT (TCMT IO) [Arg Term]
forall (m :: * -> *) a.
(Monad m, Subst a) =>
NamesT m (AbsN a) -> [NamesT m (SubstArg a)] -> NamesT m a
`applyN` ((Arg Term -> Term)
-> NamesT (TCMT IO) (Arg Term) -> NamesT (TCMT IO) Term
forall a b. (a -> b) -> NamesT (TCMT IO) a -> NamesT (TCMT IO) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Arg Term -> Term
forall e. Arg e -> e
unArg (NamesT (TCMT IO) (Arg Term) -> NamesT (TCMT IO) Term)
-> [NamesT (TCMT IO) (Arg Term)] -> [NamesT (TCMT IO) Term]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [NamesT (TCMT IO) (Arg Term)]
ArgVars (TCMT IO)
g1)
             (phi, p) <- fromMaybe __IMPOSSIBLE__ . uncons <$> sequence phi_p
             x0 <- sequence x0
             pure $ DefP defaultPatternInfo q_trX $ param_args ++ p ++ [phi] ++ x0
      trX = ((AbsN (AbsN DeBruijnPattern) -> AbsN (AbsN Term))
-> AbsN (AbsN (AbsN DeBruijnPattern)) -> AbsN (AbsN (AbsN Term))
forall a b. (a -> b) -> AbsN a -> AbsN b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((AbsN (AbsN DeBruijnPattern) -> AbsN (AbsN Term))
 -> AbsN (AbsN (AbsN DeBruijnPattern)) -> AbsN (AbsN (AbsN Term)))
-> ((DeBruijnPattern -> Term)
    -> AbsN (AbsN DeBruijnPattern) -> AbsN (AbsN Term))
-> (DeBruijnPattern -> Term)
-> AbsN (AbsN (AbsN DeBruijnPattern))
-> AbsN (AbsN (AbsN Term))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AbsN DeBruijnPattern -> AbsN Term)
-> AbsN (AbsN DeBruijnPattern) -> AbsN (AbsN Term)
forall a b. (a -> b) -> AbsN a -> AbsN b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((AbsN DeBruijnPattern -> AbsN Term)
 -> AbsN (AbsN DeBruijnPattern) -> AbsN (AbsN Term))
-> ((DeBruijnPattern -> Term) -> AbsN DeBruijnPattern -> AbsN Term)
-> (DeBruijnPattern -> Term)
-> AbsN (AbsN DeBruijnPattern)
-> AbsN (AbsN Term)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DeBruijnPattern -> Term) -> AbsN DeBruijnPattern -> AbsN Term
forall a b. (a -> b) -> AbsN a -> AbsN b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) DeBruijnPattern -> Term
patternToTerm (AbsN (AbsN (AbsN DeBruijnPattern)) -> AbsN (AbsN (AbsN Term)))
-> NamesT (TCMT IO) (AbsN (AbsN (AbsN DeBruijnPattern)))
-> NamesT (TCMT IO) (AbsN (AbsN (AbsN Term)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamesT (TCMT IO) (AbsN (AbsN (AbsN DeBruijnPattern)))
trX'
  let
    hcompD' [NamesT (TCMT IO) Term]
g1 [NamesT (TCMT IO) Term]
v =
        [Arg [Char]]
-> (ArgVars (TCMT IO) -> NamesT (TCMT IO) DeBruijnPattern)
-> NamesT (TCMT IO) (AbsN DeBruijnPattern)
forall (m :: * -> *) a.
Monad m =>
[Arg [Char]] -> (ArgVars m -> NamesT m a) -> NamesT m (AbsN a)
bindNArg [[Char] -> Arg [Char]
forall e. e -> Arg e
argH [Char]
"psi",[Char] -> Arg [Char]
forall e. e -> Arg e
argN [Char]
"u", [Char] -> Arg [Char]
forall e. e -> Arg e
argN [Char]
"u0"] ((ArgVars (TCMT IO) -> NamesT (TCMT IO) DeBruijnPattern)
 -> NamesT (TCMT IO) (AbsN DeBruijnPattern))
-> (ArgVars (TCMT IO) -> NamesT (TCMT IO) DeBruijnPattern)
-> NamesT (TCMT IO) (AbsN DeBruijnPattern)
forall a b. (a -> b) -> a -> b
$ \ ArgVars (TCMT IO)
x0 -> do
        x0 <- [NamesT (TCMT IO) (NamedArg DeBruijnPattern)]
-> NamesT (TCMT IO) [NamedArg DeBruijnPattern]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence [NamesT (TCMT IO) (NamedArg DeBruijnPattern)]
ArgVars (TCMT IO)
x0
        LEl l t <- fromMaybe __IMPOSSIBLE__ <.> toLType =<< do pure dT `applyN` g1 `applyN` v
        let ty = (Term -> NamedArg DeBruijnPattern)
-> [Term] -> [NamedArg DeBruijnPattern]
forall a b. (a -> b) -> [a] -> [b]
map ((Term -> Named_ DeBruijnPattern)
-> Arg Term -> NamedArg DeBruijnPattern
forall a b. (a -> b) -> Arg a -> Arg b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (DeBruijnPattern -> Named_ DeBruijnPattern
forall a name. a -> Named name a
unnamed (DeBruijnPattern -> Named_ DeBruijnPattern)
-> (Term -> DeBruijnPattern) -> Term -> Named_ DeBruijnPattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term -> DeBruijnPattern
forall a. Term -> Pattern' a
dotP) (Arg Term -> NamedArg DeBruijnPattern)
-> (Term -> Arg Term) -> Term -> NamedArg DeBruijnPattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term -> Arg Term
forall e. e -> Arg e
argH) [Level -> Term
Level Level
l,Term
t]
        pure $ DefP defaultPatternInfo q_hcomp $ ty ++ x0
  hcompD <- runNamesT [] $
            bindN (map unArg $ gamma1ArgNames) $ \ Vars (TCMT IO)
g1 -> do
            [[Char]]
-> (Vars (TCMT IO) -> NamesT (TCMT IO) (AbsN Term))
-> NamesT (TCMT IO) (AbsN (AbsN Term))
forall (m :: * -> *) a.
Monad m =>
[[Char]] -> (Vars m -> NamesT m a) -> NamesT m (AbsN a)
bindN (Tele (Dom Type) -> [[Char]]
teleNames (Tele (Dom Type) -> [[Char]]) -> Tele (Dom Type) -> [[Char]]
forall a b. (a -> b) -> a -> b
$ AbsN (Tele (Dom Type)) -> Tele (Dom Type)
forall a. AbsN a -> a
unAbsN (AbsN (Tele (Dom Type)) -> Tele (Dom Type))
-> AbsN (Tele (Dom Type)) -> Tele (Dom Type)
forall a b. (a -> b) -> a -> b
$ AbsN (Tele (Dom Type))
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' =
            [[Char]]
-> (Vars (TCMT IO)
    -> NamesT (TCMT IO) (AbsN (AbsN DeBruijnPattern)))
-> NamesT (TCMT IO) (AbsN (AbsN (AbsN DeBruijnPattern)))
forall (m :: * -> *) a.
Monad m =>
[[Char]] -> (Vars m -> NamesT m a) -> NamesT m (AbsN a)
bindN ((Arg [Char] -> [Char]) -> [Arg [Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map Arg [Char] -> [Char]
forall e. Arg e -> e
unArg [Arg [Char]]
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 [Char]
-> (Vars1 (TCMT IO) -> NamesT (TCMT IO) (AbsN DeBruijnPattern))
-> NamesT (TCMT IO) (AbsN (AbsN DeBruijnPattern))
forall (m :: * -> *) a.
Monad m =>
List1 [Char] -> (Vars1 m -> NamesT m a) -> NamesT m (AbsN a)
bindN1 ((Arg [Char] -> [Char]) -> NonEmpty (Arg [Char]) -> List1 [Char]
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Arg [Char] -> [Char]
forall e. Arg e -> e
unArg ([Char] -> Arg [Char]
forall e. e -> Arg e
defaultArg [Char]
"phi" Arg [Char] -> [Arg [Char]] -> NonEmpty (Arg [Char])
forall a. a -> [a] -> NonEmpty a
:| [Arg [Char]]
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
            [[Char]]
-> (Vars (TCMT IO) -> NamesT (TCMT IO) DeBruijnPattern)
-> NamesT (TCMT IO) (AbsN DeBruijnPattern)
forall (m :: * -> *) a.
Monad m =>
[[Char]] -> (Vars m -> NamesT m a) -> NamesT m (AbsN a)
bindN [[Char]
"psi",[Char]
"u",[Char]
"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` (NonEmpty (NamesT (TCMT IO) DeBruijnPattern)
-> [Item (NonEmpty (NamesT (TCMT IO) DeBruijnPattern))]
forall l. IsList l => l -> [Item l]
List1.toList NonEmpty (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 (Tele (Dom Type)))
delta NamesT (TCMT IO) (AbsN (Tele (Dom Type)))
-> [NamesT (TCMT IO) (SubstArg (Tele (Dom Type)))]
-> NamesT (TCMT IO) (Tele (Dom Type))
forall (m :: * -> *) a.
(Monad m, Subst a) =>
NamesT m (AbsN a) -> [NamesT m (SubstArg a)] -> NamesT m a
`applyN` ([NamesT (TCMT IO) Term]
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
    [Char]
-> NamesT (TCMT IO) Type
-> (Var (TCMT IO) -> NamesT (TCMT IO) (Tele (Dom Type)))
-> NamesT (TCMT IO) (Tele (Dom Type))
forall (m :: * -> *) a.
(Monad m, Abstract a) =>
[Char] -> NamesT m Type -> (Var m -> NamesT m a) -> NamesT m a
abstractT [Char]
"φ" (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) (Tele (Dom Type)))
 -> NamesT (TCMT IO) (Tele (Dom Type)))
-> (Var (TCMT IO) -> NamesT (TCMT IO) (Tele (Dom Type)))
-> NamesT (TCMT IO) (Tele (Dom Type))
forall a b. (a -> b) -> a -> b
$ \ Var (TCMT IO)
phi -> do
    NamesT (TCMT IO) (Tele (Dom Type))
-> (Vars (TCMT IO) -> NamesT (TCMT IO) (Tele (Dom Type)))
-> NamesT (TCMT IO) (Tele (Dom Type))
forall (m :: * -> *) a.
(Monad m, Abstract a) =>
NamesT m (Tele (Dom Type)) -> (Vars m -> NamesT m a) -> NamesT m a
abstractN (NamesT (TCMT IO) (AbsN (Tele (Dom Type)))
xTelI NamesT (TCMT IO) (AbsN (Tele (Dom Type)))
-> [NamesT (TCMT IO) (SubstArg (Tele (Dom Type)))]
-> NamesT (TCMT IO) (Tele (Dom Type))
forall (m :: * -> *) a.
(Monad m, Subst a) =>
NamesT m (AbsN a) -> [NamesT m (SubstArg a)] -> NamesT m a
`applyN` [NamesT (TCMT IO) Term]
[NamesT (TCMT IO) (SubstArg (Tele (Dom Type)))]
Vars (TCMT IO)
g1) ((Vars (TCMT IO) -> NamesT (TCMT IO) (Tele (Dom Type)))
 -> NamesT (TCMT IO) (Tele (Dom Type)))
-> (Vars (TCMT IO) -> NamesT (TCMT IO) (Tele (Dom Type)))
-> NamesT (TCMT IO) (Tele (Dom Type))
forall a b. (a -> b) -> a -> b
$ \ Vars (TCMT IO)
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
    [Char]
-> NamesT (TCMT IO) Type
-> (Var (TCMT IO) -> NamesT (TCMT IO) (Tele (Dom Type)))
-> NamesT (TCMT IO) (Tele (Dom Type))
forall (m :: * -> *) a.
(Monad m, Abstract a) =>
[Char] -> NamesT m Type -> (Var m -> NamesT m a) -> NamesT m a
abstractT [Char]
"ψ" (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) (Tele (Dom Type)))
 -> NamesT (TCMT IO) (Tele (Dom Type)))
-> (Var (TCMT IO) -> NamesT (TCMT IO) (Tele (Dom Type)))
-> NamesT (TCMT IO) (Tele (Dom Type))
forall a b. (a -> b) -> a -> b
$ \ Var (TCMT IO)
psi -> do
    [Char]
-> NamesT (TCMT IO) Type
-> (Var (TCMT IO) -> NamesT (TCMT IO) (Tele (Dom Type)))
-> NamesT (TCMT IO) (Tele (Dom Type))
forall (m :: * -> *) a.
(Monad m, Abstract a) =>
[Char] -> NamesT m Type -> (Var m -> NamesT m a) -> NamesT m a
abstractT [Char]
"u" (Type -> NamesT (TCMT IO) Type
forall a. a -> NamesT (TCMT IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Type
interval NamesT (TCMT IO) Type
-> NamesT (TCMT IO) Type -> NamesT (TCMT IO) Type
forall (m :: * -> *). HasOptions m => m Type -> m Type -> m Type
--> [Char]
-> NamesT (TCMT IO) Term
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall (m :: * -> *).
(MonadAddContext m, HasBuiltins m, MonadDebug m) =>
[Char]
-> NamesT m Term
-> (NamesT m Term -> NamesT m Type)
-> NamesT m Type
pPi' [Char]
"o" NamesT (TCMT IO) Term
Var (TCMT IO)
psi (\ NamesT (TCMT IO) Term
_ -> NamesT (TCMT IO) Type
ty)) ((Var (TCMT IO) -> NamesT (TCMT IO) (Tele (Dom Type)))
 -> NamesT (TCMT IO) (Tele (Dom Type)))
-> (Var (TCMT IO) -> NamesT (TCMT IO) (Tele (Dom Type)))
-> NamesT (TCMT IO) (Tele (Dom Type))
forall a b. (a -> b) -> a -> b
$ \ Var (TCMT IO)
u -> do
    [Char]
-> NamesT (TCMT IO) Type
-> (Var (TCMT IO) -> NamesT (TCMT IO) (Tele (Dom Type)))
-> NamesT (TCMT IO) (Tele (Dom Type))
forall (m :: * -> *) a.
(Monad m, Abstract a) =>
[Char] -> NamesT m Type -> (Var m -> NamesT m a) -> NamesT m a
abstractT [Char]
"u0" NamesT (TCMT IO) Type
ty ((Var (TCMT IO) -> NamesT (TCMT IO) (Tele (Dom Type)))
 -> NamesT (TCMT IO) (Tele (Dom Type)))
-> (Var (TCMT IO) -> NamesT (TCMT IO) (Tele (Dom Type)))
-> NamesT (TCMT IO) (Tele (Dom Type))
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) (Tele (Dom Type))
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
    [Char]
-> (Var (TCMT IO)
    -> NamesT
         (TCMT IO)
         (AbsN
            (Abs
               (Abs (Abs (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term)))))))
-> NamesT
     (TCMT IO)
     (Abs
        (AbsN
           (Abs
              (Abs (Abs (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term)))))))
forall (m :: * -> *) a.
Monad m =>
[Char]
-> ((forall b. (Subst b, DeBruijn b) => NamesT m b) -> NamesT m a)
-> NamesT m (Abs a)
bind [Char]
"φ" ((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
    [[Char]]
-> (Vars (TCMT IO)
    -> NamesT
         (TCMT IO)
         (Abs
            (Abs (Abs (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term))))))
-> NamesT
     (TCMT IO)
     (AbsN
        (Abs
           (Abs (Abs (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term))))))
forall (m :: * -> *) a.
Monad m =>
[[Char]] -> (Vars m -> NamesT m a) -> NamesT m (AbsN a)
bindN ((Arg [Char] -> [Char]) -> [Arg [Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map Arg [Char] -> [Char]
forall e. Arg e -> e
unArg [Arg [Char]]
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
    [Char]
-> (Var (TCMT IO)
    -> NamesT
         (TCMT IO)
         (Abs (Abs (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term)))))
-> NamesT
     (TCMT IO)
     (Abs
        (Abs (Abs (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term)))))
forall (m :: * -> *) a.
Monad m =>
[Char]
-> ((forall b. (Subst b, DeBruijn b) => NamesT m b) -> NamesT m a)
-> NamesT m (Abs a)
bind [Char]
"ψ" ((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
    [Char]
-> (Var (TCMT IO)
    -> NamesT
         (TCMT IO)
         (Abs (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term))))
-> NamesT
     (TCMT IO)
     (Abs (Abs (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term))))
forall (m :: * -> *) a.
Monad m =>
[Char]
-> ((forall b. (Subst b, DeBruijn b) => NamesT m b) -> NamesT m a)
-> NamesT m (Abs a)
bind [Char]
"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
    [Char]
-> (Var (TCMT IO)
    -> NamesT
         (TCMT IO) (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term)))
-> NamesT
     (TCMT IO) (Abs (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term)))
forall (m :: * -> *) a.
Monad m =>
[Char]
-> ((forall b. (Subst b, DeBruijn b) => NamesT m b) -> NamesT m a)
-> NamesT m (Abs a)
bind [Char]
"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
    [[Char]]
-> (Vars (TCMT IO)
    -> NamesT (TCMT IO) ([NamedArg DeBruijnPattern], Dom Type, Term))
-> NamesT
     (TCMT IO) (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term))
forall (m :: * -> *) a.
Monad m =>
[[Char]] -> (Vars m -> NamesT m a) -> NamesT m (AbsN a)
bindN ((Arg [Char] -> [Char]) -> [Arg [Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map Arg [Char] -> [Char]
forall e. Arg e -> e
unArg [Arg [Char]]
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 <- (Tele (Dom Type)
-> NamesT (TCMT IO) (NamesT (TCMT IO) (Tele (Dom Type)))
forall (m :: * -> *) a.
(Monad m, Subst a) =>
a -> NamesT m (NamesT m a)
open (Tele (Dom Type)
 -> NamesT (TCMT IO) (NamesT (TCMT IO) (Tele (Dom Type))))
-> NamesT (TCMT IO) (Tele (Dom Type))
-> NamesT (TCMT IO) (NamesT (TCMT IO) (Tele (Dom Type)))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (NamesT (TCMT IO) (Tele (Dom Type))
 -> NamesT (TCMT IO) (NamesT (TCMT IO) (Tele (Dom Type))))
-> NamesT (TCMT IO) (Tele (Dom Type))
-> NamesT (TCMT IO) (NamesT (TCMT IO) (Tele (Dom Type)))
forall a b. (a -> b) -> a -> b
$ AbsN (Tele (Dom Type)) -> NamesT (TCMT IO) (AbsN (Tele (Dom Type)))
forall a. a -> NamesT (TCMT IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure AbsN (Tele (Dom Type))
xTel NamesT (TCMT IO) (AbsN (Tele (Dom Type)))
-> [NamesT (TCMT IO) (SubstArg (Tele (Dom Type)))]
-> NamesT (TCMT IO) (Tele (Dom Type))
forall (m :: * -> *) a.
(Monad m, Subst a) =>
NamesT m (AbsN a) -> [NamesT m (SubstArg a)] -> NamesT m a
`applyN` [NamesT (TCMT IO) Term]
[NamesT (TCMT IO) (SubstArg (Tele (Dom Type)))]
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) =>
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,[Char]
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall (m :: * -> *).
Monad m =>
[Char] -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
lam [Char]
"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  ,[Char]
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall (m :: * -> *).
Monad m =>
[Char] -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
lam [Char]
"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
_ -> [Char]
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall (m :: * -> *).
Monad m =>
[Char] -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
ilam [Char]
"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.
(Monad m, Subst a) =>
a -> NamesT m (NamesT m a)
open ([Term] -> NamesT (TCMT IO) [NamesT (TCMT IO) Term])
-> NamesT (TCMT IO) [Term]
-> NamesT (TCMT IO) [NamesT (TCMT IO) Term]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (NamesT (TCMT IO) [Term]
 -> NamesT (TCMT IO) [NamesT (TCMT IO) Term])
-> NamesT (TCMT IO) [Term]
-> NamesT (TCMT IO) [NamesT (TCMT IO) Term]
forall a b. (a -> b) -> a -> b
$ (Abs [Term] -> Term -> [Term]
Abs [Term] -> SubstArg [Term] -> [Term]
forall a. Subst a => Abs a -> SubstArg a -> a
absApp (Abs [Term] -> Term -> [Term])
-> NamesT (TCMT IO) (Abs [Term])
-> NamesT (TCMT IO) (Term -> [Term])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamesT (TCMT IO) (Abs [Term])
args NamesT (TCMT IO) (Term -> [Term])
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) [Term]
forall a b.
NamesT (TCMT IO) (a -> b)
-> NamesT (TCMT IO) a -> NamesT (TCMT IO) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Term -> NamesT (TCMT IO) Term
forall a. a -> NamesT (TCMT IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
io)
            -- faces ought to be constant on "j"
            faces <- pure (fmap (map fst) old_sides) `applyN` args1
            us <- forM (mapM (map snd) old_sides) $ \ AbsN Term
u -> do
                  [Char]
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall (m :: * -> *).
Monad m =>
[Char] -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
lam [Char]
"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 -> [Char]
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall (m :: * -> *).
Monad m =>
[Char] -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
ilam [Char]
"o" ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
 -> NamesT (TCMT IO) Term)
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall a b. (a -> b) -> a -> b
$ \ NamesT (TCMT IO) Term
_ -> do
                    args <- ((Term -> NamesT (TCMT IO) (NamesT (TCMT IO) Term))
-> [Term] -> NamesT (TCMT IO) [NamesT (TCMT IO) Term]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Term -> NamesT (TCMT IO) (NamesT (TCMT IO) Term)
forall (m :: * -> *) a.
(Monad m, Subst a) =>
a -> NamesT m (NamesT m a)
open ([Term] -> NamesT (TCMT IO) [NamesT (TCMT IO) Term])
-> NamesT (TCMT IO) [Term]
-> NamesT (TCMT IO) [NamesT (TCMT IO) Term]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (NamesT (TCMT IO) [Term]
 -> NamesT (TCMT IO) [NamesT (TCMT IO) Term])
-> NamesT (TCMT IO) [Term]
-> NamesT (TCMT IO) [NamesT (TCMT IO) Term]
forall a b. (a -> b) -> a -> b
$ (Abs [Term] -> Term -> [Term]
Abs [Term] -> SubstArg [Term] -> [Term]
forall a. Subst a => Abs a -> SubstArg a -> a
absApp (Abs [Term] -> Term -> [Term])
-> NamesT (TCMT IO) (Abs [Term])
-> NamesT (TCMT IO) (Term -> [Term])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamesT (TCMT IO) (Abs [Term])
args NamesT (TCMT IO) (Term -> [Term])
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) [Term]
forall a b.
NamesT (TCMT IO) (a -> b)
-> NamesT (TCMT IO) a -> NamesT (TCMT IO) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> NamesT (TCMT IO) Term
j)
                    pure u `applyN` args
            forM (zip faces us) $ \ (Term
phi,Term
u) -> (NamesT (TCMT IO) Term
 -> NamesT (TCMT IO) Term
 -> (NamesT (TCMT IO) Term, NamesT (TCMT IO) Term))
-> NamesT (TCMT IO) (NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) (NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) (NamesT (TCMT IO) Term, NamesT (TCMT IO) Term)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (,) (Term -> NamesT (TCMT IO) (NamesT (TCMT IO) Term)
forall (m :: * -> *) a.
(Monad m, Subst a) =>
a -> NamesT m (NamesT m a)
open Term
phi) (Term -> NamesT (TCMT IO) (NamesT (TCMT IO) Term)
forall (m :: * -> *) a.
(Monad m, Subst a) =>
a -> NamesT m (NamesT m a)
open Term
u)
    rhs <- do
      d_f <- (open =<<) $ bind "j" $ \ Var (TCMT IO)
j -> do
        tel <- [Char]
-> (Var (TCMT IO) -> NamesT (TCMT IO) (Tele (Dom Type)))
-> NamesT (TCMT IO) (Abs (Tele (Dom Type)))
forall (m :: * -> *) a.
Monad m =>
[Char]
-> ((forall b. (Subst b, DeBruijn b) => NamesT m b) -> NamesT m a)
-> NamesT m (Abs a)
bind [Char]
"j" ((Var (TCMT IO) -> NamesT (TCMT IO) (Tele (Dom Type)))
 -> NamesT (TCMT IO) (Abs (Tele (Dom Type))))
-> (Var (TCMT IO) -> NamesT (TCMT IO) (Tele (Dom Type)))
-> NamesT (TCMT IO) (Abs (Tele (Dom Type)))
forall a b. (a -> b) -> a -> b
$ \ Var (TCMT IO)
j -> NamesT (TCMT IO) (AbsN (Tele (Dom Type)))
delta NamesT (TCMT IO) (AbsN (Tele (Dom Type)))
-> [NamesT (TCMT IO) (SubstArg (Tele (Dom Type)))]
-> NamesT (TCMT IO) (Tele (Dom Type))
forall (m :: * -> *) a.
(Monad m, Subst a) =>
NamesT m (AbsN a) -> [NamesT m (SubstArg a)] -> NamesT m a
`applyN` ([NamesT (TCMT IO) Term]
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 = [Char]
-> (Var (TCMT IO) -> NamesT (TCMT IO) [Term])
-> NamesT (TCMT IO) (Abs [Term])
forall (m :: * -> *) a.
Monad m =>
[Char]
-> ((forall b. (Subst b, DeBruijn b) => NamesT m b) -> NamesT m a)
-> NamesT m (Abs a)
bind [Char]
"j" ((Var (TCMT IO) -> NamesT (TCMT IO) [Term])
 -> NamesT (TCMT IO) (Abs [Term]))
-> (Var (TCMT IO) -> NamesT (TCMT IO) [Term])
-> NamesT (TCMT IO) (Abs [Term])
forall a b. (a -> b) -> a -> b
$ \ Var (TCMT IO)
j -> do
            g1 <- [NamesT (TCMT IO) Term] -> NamesT (TCMT IO) [Term]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence [NamesT (TCMT IO) Term]
Vars (TCMT IO)
g1
            x <- absApp <$> pat_rec <*> neg j
            ys <- absApp <$> d_f <*> neg j
            pure $ g1 ++ x:ys
      ty <- (open =<<) $ bind "j" $ \ Var (TCMT IO)
j -> do
           args <- ((Term -> NamesT (TCMT IO) (NamesT (TCMT IO) Term))
-> [Term] -> NamesT (TCMT IO) [NamesT (TCMT IO) Term]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Term -> NamesT (TCMT IO) (NamesT (TCMT IO) Term)
forall (m :: * -> *) a.
(Monad m, Subst a) =>
a -> NamesT m (NamesT m a)
open ([Term] -> NamesT (TCMT IO) [NamesT (TCMT IO) Term])
-> NamesT (TCMT IO) [Term]
-> NamesT (TCMT IO) [NamesT (TCMT IO) Term]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (NamesT (TCMT IO) [Term]
 -> NamesT (TCMT IO) [NamesT (TCMT IO) Term])
-> NamesT (TCMT IO) [Term]
-> NamesT (TCMT IO) [NamesT (TCMT IO) Term]
forall a b. (a -> b) -> a -> b
$ Abs [Term] -> Term -> [Term]
Abs [Term] -> SubstArg [Term] -> [Term]
forall a. Subst a => Abs a -> SubstArg a -> a
absApp (Abs [Term] -> Term -> [Term])
-> NamesT (TCMT IO) (Abs [Term])
-> NamesT (TCMT IO) (Term -> [Term])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamesT (TCMT IO) (Abs [Term])
args NamesT (TCMT IO) (Term -> [Term])
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) [Term]
forall a b.
NamesT (TCMT IO) (a -> b)
-> NamesT (TCMT IO) a -> NamesT (TCMT IO) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> NamesT (TCMT IO) Term
Var (TCMT IO)
j
           fmap unDom $ old_ty `applyN` args
      let face = Term -> NamesT (TCMT IO) Term
forall a. a -> NamesT (TCMT IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
iz
      othersys <- (open =<<) $ lam "j" $ \ NamesT (TCMT IO) Term
j -> [Char]
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall (m :: * -> *).
Monad m =>
[Char] -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
ilam [Char]
"o" ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
 -> NamesT (TCMT IO) Term)
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall a b. (a -> b) -> a -> b
$ \ NamesT (TCMT IO) Term
_ -> do
        args' <- ((Term -> NamesT (TCMT IO) (NamesT (TCMT IO) Term))
-> [Term] -> NamesT (TCMT IO) [NamesT (TCMT IO) Term]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Term -> NamesT (TCMT IO) (NamesT (TCMT IO) Term)
forall (m :: * -> *) a.
(Monad m, Subst a) =>
a -> NamesT m (NamesT m a)
open ([Term] -> NamesT (TCMT IO) [NamesT (TCMT IO) Term])
-> NamesT (TCMT IO) [Term]
-> NamesT (TCMT IO) [NamesT (TCMT IO) Term]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (NamesT (TCMT IO) [Term]
 -> NamesT (TCMT IO) [NamesT (TCMT IO) Term])
-> NamesT (TCMT IO) [Term]
-> NamesT (TCMT IO) [NamesT (TCMT IO) Term]
forall a b. (a -> b) -> a -> b
$ Abs [Term] -> Term -> [Term]
Abs [Term] -> SubstArg [Term] -> [Term]
forall a. Subst a => Abs a -> SubstArg a -> a
absApp (Abs [Term] -> Term -> [Term])
-> NamesT (TCMT IO) (Abs [Term])
-> NamesT (TCMT IO) (Term -> [Term])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamesT (TCMT IO) (Abs [Term])
args NamesT (TCMT IO) (Term -> [Term])
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) [Term]
forall a b.
NamesT (TCMT IO) (a -> b)
-> NamesT (TCMT IO) a -> NamesT (TCMT IO) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> NamesT (TCMT IO) Term
j
        fmap (Def f) $ (fmap patternsToElims <$> old_ps) `applyN` args'
      sys <- mkBndry args
      let
        -- we could specialize all of sysphi/syspsi/base to compute
        -- away trX or the hcomp respectively, should lead to
        -- smaller/more efficient terms.
        --
        -- we could also ditch sysphi completely,
        -- as the computation rule for hcomp would achieve the same.
        sysphi = NamesT (TCMT IO) Term
othersys
        syspsi = NamesT (TCMT IO) Term
othersys
      base <- (open =<<) $ do
        args' <- (mapM open =<<) $ absApp <$> args <*> pure iz
        fmap (Def f) $ (fmap patternsToElims <$> old_ps) `applyN` args'
      transpSys ty ((phi,sysphi):(psi,syspsi):sys) face base
    (,,) <$> ps <*> rhsTy <*> pure rhs
  let (ps,ty,rhs) = unAbsN $ unAbs $ unAbs $ unAbs $ unAbsN $ unAbs $ unAbsN $ ps_ty_rhs
  reportSDoc "tc.cover.trx.hcomp" 20 $ "trX-hcomp clause for" <+> prettyTCM f
  let c = Clause { clauseLHSRange :: Range
clauseLHSRange  = Range
forall a. Range' a
noRange
                 , clauseFullRange :: Range
clauseFullRange = Range
forall a. Range' a
noRange
                 , clauseTel :: Tele (Dom Type)
clauseTel       = Tele (Dom Type)
cTel
                 , namedClausePats :: [NamedArg DeBruijnPattern]
namedClausePats = [NamedArg DeBruijnPattern]
ps
                 , clauseBody :: Maybe Term
clauseBody      = Term -> Maybe Term
forall a. a -> Maybe a
Just Term
rhs
                 , clauseType :: Maybe (Arg Type)
clauseType      = Arg Type -> Maybe (Arg Type)
forall a. a -> Maybe a
Just (Arg Type -> Maybe (Arg Type)) -> Arg Type -> Maybe (Arg Type)
forall a b. (a -> b) -> a -> b
$ ArgInfo -> Type -> Arg Type
forall e. ArgInfo -> e -> Arg e
Arg (Dom Type -> ArgInfo
forall a. LensArgInfo a => a -> ArgInfo
getArgInfo Dom Type
ty) (Dom Type -> Type
forall t e. Dom' t e -> e
unDom Dom Type
ty)
                 , clauseCatchall :: Catchall
clauseCatchall    = Catchall
forall a. Null a => a
empty
                 , clauseRecursive :: ClauseRecursive
clauseRecursive   = ClauseRecursive
YesRecursive
                 , clauseUnreachable :: Maybe Bool
clauseUnreachable = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False
                 , clauseEllipsis :: ExpandedEllipsis
clauseEllipsis    = ExpandedEllipsis
NoEllipsis
                 , clauseWhereModule :: Maybe ModuleName
clauseWhereModule = Maybe ModuleName
forall a. Maybe a
Nothing
                 }
  debugClause "tc.cover.trx.hcomp" c
  return c

createMissingTrXConClause ::
     QName -- trX
  -> QName -- f defined
  -> Arg Nat
  -> BlockingVar
  -> SplitClause
  -> QName -- constructor name
  -> UnifyEquiv
  -> TCM Clause
createMissingTrXConClause :: QName
-> QName
-> Arg Int
-> BlockingVar
-> SplitClause
-> QName
-> UnifyEquiv
-> TCM Clause
createMissingTrXConClause QName
q_trX QName
f Arg Int
n BlockingVar
x SplitClause
old_sc QName
c (UE Tele (Dom Type)
gamma Tele (Dom Type)
gamma' Tele (Dom Type)
xTel [Term]
u [Term]
v Substitution' DeBruijnPattern
rho Substitution' Term
tau Substitution' Term
leftInv) = do
  [Char] -> Int -> TCMT IO Doc -> TCMT IO ()
forall (m :: * -> *).
MonadDebug m =>
[Char] -> Int -> TCMT IO Doc -> m ()
reportSDoc [Char]
"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
  [Char] -> Int -> TCMT IO Doc -> TCMT IO ()
forall (m :: * -> *).
MonadDebug m =>
[Char] -> Int -> TCMT IO Doc -> m ()
reportSDoc [Char]
"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
<+> Tele (Dom Type) -> TCMT IO Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
forall (m :: * -> *). MonadPretty m => Tele (Dom Type) -> m Doc
prettyTCM Tele (Dom Type)
gamma
    , TCMT IO Doc
"gamma'" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> Tele (Dom Type) -> TCMT IO Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
forall (m :: * -> *). MonadPretty m => Tele (Dom Type) -> m Doc
prettyTCM Tele (Dom Type)
gamma'
    , TCMT IO Doc
"xTel" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> Tele (Dom Type) -> TCMT IO Doc -> TCMT IO Doc
forall b (m :: * -> *) a.
(AddContext b, MonadAddContext m) =>
b -> m a -> m a
forall (m :: * -> *) a.
MonadAddContext m =>
Tele (Dom Type) -> m a -> m a
addContext Tele (Dom Type)
gamma (Tele (Dom Type) -> TCMT IO Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
forall (m :: * -> *). MonadPretty m => Tele (Dom Type) -> m Doc
prettyTCM Tele (Dom Type)
xTel)
    , TCMT IO Doc
"u"  TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> Tele (Dom Type) -> TCMT IO Doc -> TCMT IO Doc
forall b (m :: * -> *) a.
(AddContext b, MonadAddContext m) =>
b -> m a -> m a
forall (m :: * -> *) a.
MonadAddContext m =>
Tele (Dom Type) -> m a -> m a
addContext Tele (Dom Type)
gamma ([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
<+> Tele (Dom Type) -> TCMT IO Doc -> TCMT IO Doc
forall b (m :: * -> *) a.
(AddContext b, MonadAddContext m) =>
b -> m a -> m a
forall (m :: * -> *) a.
MonadAddContext m =>
Tele (Dom Type) -> m a -> m a
addContext Tele (Dom Type)
gamma ([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
<+> Tele (Dom Type) -> TCMT IO Doc -> TCMT IO Doc
forall b (m :: * -> *) a.
(AddContext b, MonadAddContext m) =>
b -> m a -> m a
forall (m :: * -> *) a.
MonadAddContext m =>
Tele (Dom Type) -> m a -> m a
addContext Tele (Dom Type)
gamma' (Substitution' DeBruijnPattern -> TCMT IO Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
forall (m :: * -> *).
MonadPretty m =>
Substitution' DeBruijnPattern -> m Doc
prettyTCM Substitution' DeBruijnPattern
rho)
    , TCMT IO Doc
"tau" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> Substitution' Term -> TCMT IO Doc
forall (m :: * -> *) a. (Applicative m, Pretty a) => a -> m Doc
pretty Substitution' Term
tau
    ]

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

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

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

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

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

  -- Γ' ⊢ ρ : Γ

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

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

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

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

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

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

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

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

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

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

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

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

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


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

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

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

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

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


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

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

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

  iz <- primIZero
  interval <- elInf primInterval
  let
      old_tel = SplitClause -> Tele (Dom Type)
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
$ [[Char]]
-> [NamedArg DeBruijnPattern] -> AbsN [NamedArg DeBruijnPattern]
forall a. [[Char]] -> a -> AbsN a
AbsN (Tele (Dom Type) -> [[Char]]
teleNames Tele (Dom Type)
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
$ [[Char]] -> Dom Type -> AbsN (Dom Type)
forall a. [[Char]] -> a -> AbsN a
AbsN (Tele (Dom Type) -> [[Char]]
teleNames Tele (Dom Type)
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 = Tele (Dom Type) -> [Arg [Char]]
teleArgNames Tele (Dom Type)
gamma
    deltaArgNames = Tele (Dom Type) -> [Arg [Char]]
teleArgNames Tele (Dom Type)
delta'
  let
    xTelI = AbsN (Tele (Dom Type)) -> NamesT (TCMT IO) (AbsN (Tele (Dom Type)))
forall a. a -> NamesT (TCMT IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AbsN (Tele (Dom Type))
 -> NamesT (TCMT IO) (AbsN (Tele (Dom Type))))
-> AbsN (Tele (Dom Type))
-> NamesT (TCMT IO) (AbsN (Tele (Dom Type)))
forall a b. (a -> b) -> a -> b
$ [[Char]] -> Tele (Dom Type) -> AbsN (Tele (Dom Type))
forall a. [[Char]] -> a -> AbsN a
AbsN (Tele (Dom Type) -> [[Char]]
teleNames Tele (Dom Type)
gamma) (Tele (Dom Type) -> AbsN (Tele (Dom Type)))
-> Tele (Dom Type) -> AbsN (Tele (Dom Type))
forall a b. (a -> b) -> a -> b
$ Type -> Tele (Dom Type) -> Tele (Dom Type)
expTelescope Type
interval Tele (Dom Type)
xTel
    delta = AbsN (Tele (Dom Type)) -> NamesT (TCMT IO) (AbsN (Tele (Dom Type)))
forall a. a -> NamesT (TCMT IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AbsN (Tele (Dom Type))
 -> NamesT (TCMT IO) (AbsN (Tele (Dom Type))))
-> AbsN (Tele (Dom Type))
-> NamesT (TCMT IO) (AbsN (Tele (Dom Type)))
forall a b. (a -> b) -> a -> b
$ [[Char]] -> Tele (Dom Type) -> AbsN (Tele (Dom Type))
forall a. [[Char]] -> a -> AbsN a
AbsN (Tele (Dom Type) -> [[Char]]
teleNames Tele (Dom Type)
gamma1x) (Tele (Dom Type) -> AbsN (Tele (Dom Type)))
-> Tele (Dom Type) -> AbsN (Tele (Dom Type))
forall a b. (a -> b) -> a -> b
$ Tele (Dom Type)
delta'
    gamma1_size = (Tele (Dom Type) -> Int
forall a. Sized a => a -> Int
size Tele (Dom Type)
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 [Char]]
-> (ArgVars (TCMT IO) -> NamesT (TCMT IO) (AbsN DeBruijnPattern))
-> NamesT (TCMT IO) (AbsN (AbsN DeBruijnPattern))
forall (m :: * -> *) a.
Monad m =>
[Arg [Char]] -> (ArgVars m -> NamesT m a) -> NamesT m (AbsN a)
bindNArg [Arg [Char]]
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 [Char]]
-> (ArgVars (TCMT IO) -> NamesT (TCMT IO) DeBruijnPattern)
-> NamesT (TCMT IO) (AbsN DeBruijnPattern)
forall (m :: * -> *) a.
Monad m =>
[Arg [Char]] -> (ArgVars m -> NamesT m a) -> NamesT m (AbsN a)
bindNArg ([[Char] -> Arg [Char]
forall e. e -> Arg e
defaultArg [Char]
"phi"] [Arg [Char]] -> [Arg [Char]] -> [Arg [Char]]
forall a. [a] -> [a] -> [a]
++ Tele (Dom Type) -> [Arg [Char]]
teleArgNames Tele (Dom Type)
xTel) ((ArgVars (TCMT IO) -> NamesT (TCMT IO) DeBruijnPattern)
 -> NamesT (TCMT IO) (AbsN DeBruijnPattern))
-> (ArgVars (TCMT IO) -> NamesT (TCMT IO) DeBruijnPattern)
-> NamesT (TCMT IO) (AbsN DeBruijnPattern)
forall a b. (a -> b) -> a -> b
$ \ ArgVars (TCMT IO)
phi_p -> do
            let ([NamesT (TCMT IO) (NamedArg DeBruijnPattern)]
g1,[NamesT (TCMT IO) (NamedArg DeBruijnPattern)]
args) = Int
-> [NamesT (TCMT IO) (NamedArg DeBruijnPattern)]
-> ([NamesT (TCMT IO) (NamedArg DeBruijnPattern)],
    [NamesT (TCMT IO) (NamedArg DeBruijnPattern)])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
gamma1_size [NamesT (TCMT IO) (NamedArg DeBruijnPattern)]
ArgVars (TCMT IO)
g1_args
            (phi, p) <- (NamedArg DeBruijnPattern, [NamedArg DeBruijnPattern])
-> Maybe (NamedArg DeBruijnPattern, [NamedArg DeBruijnPattern])
-> (NamedArg DeBruijnPattern, [NamedArg DeBruijnPattern])
forall a. a -> Maybe a -> a
fromMaybe (NamedArg DeBruijnPattern, [NamedArg DeBruijnPattern])
forall a. HasCallStack => a
__IMPOSSIBLE__ (Maybe (NamedArg DeBruijnPattern, [NamedArg DeBruijnPattern])
 -> (NamedArg DeBruijnPattern, [NamedArg DeBruijnPattern]))
-> ([NamedArg DeBruijnPattern]
    -> Maybe (NamedArg DeBruijnPattern, [NamedArg DeBruijnPattern]))
-> [NamedArg DeBruijnPattern]
-> (NamedArg DeBruijnPattern, [NamedArg DeBruijnPattern])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [NamedArg DeBruijnPattern]
-> Maybe (NamedArg DeBruijnPattern, [NamedArg DeBruijnPattern])
forall a. [a] -> Maybe (a, [a])
uncons ([NamedArg DeBruijnPattern]
 -> (NamedArg DeBruijnPattern, [NamedArg DeBruijnPattern]))
-> NamesT (TCMT IO) [NamedArg DeBruijnPattern]
-> NamesT
     (TCMT IO) (NamedArg DeBruijnPattern, [NamedArg DeBruijnPattern])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [NamesT (TCMT IO) (NamedArg DeBruijnPattern)]
-> NamesT (TCMT IO) [NamedArg DeBruijnPattern]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence [NamesT (TCMT IO) (NamedArg DeBruijnPattern)]
ArgVars (TCMT IO)
phi_p
            args <- sequence args
            let cargs = Named_ DeBruijnPattern -> NamedArg DeBruijnPattern
forall e. e -> Arg e
defaultArg (Named_ DeBruijnPattern -> NamedArg DeBruijnPattern)
-> Named_ DeBruijnPattern -> NamedArg DeBruijnPattern
forall a b. (a -> b) -> a -> b
$ DeBruijnPattern -> Named_ DeBruijnPattern
forall a name. a -> Named name a
unnamed (DeBruijnPattern -> Named_ DeBruijnPattern)
-> DeBruijnPattern -> Named_ DeBruijnPattern
forall a b. (a -> b) -> a -> b
$ ConHead
-> ConPatternInfo -> [NamedArg DeBruijnPattern] -> DeBruijnPattern
forall x.
ConHead -> ConPatternInfo -> [NamedArg (Pattern' x)] -> Pattern' x
ConP ConHead
chead ConPatternInfo
noConPatternInfo [NamedArg DeBruijnPattern]
args
            -- 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) ([Char] -> Term -> Abs Term
forall a. [Char] -> a -> Abs a
Abs [Char]
"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' = [[Char]]
-> (Vars (TCMT IO) -> NamesT (TCMT IO) (AbsN (Abs [Term])))
-> NamesT (TCMT IO) (AbsN (AbsN (Abs [Term])))
forall (m :: * -> *) a.
Monad m =>
[[Char]] -> (Vars m -> NamesT m a) -> NamesT m (AbsN a)
bindN ((Arg [Char] -> [Char]) -> [Arg [Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map Arg [Char] -> [Char]
forall e. Arg e -> e
unArg [Arg [Char]]
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
                [[Char]]
-> (Vars (TCMT IO) -> NamesT (TCMT IO) (Abs [Term]))
-> NamesT (TCMT IO) (AbsN (Abs [Term]))
forall (m :: * -> *) a.
Monad m =>
[[Char]] -> (Vars m -> NamesT m a) -> NamesT m (AbsN a)
bindN ((Arg [Char] -> [Char]) -> [Arg [Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map Arg [Char] -> [Char]
forall e. Arg e -> e
unArg ([Arg [Char]] -> [[Char]]) -> [Arg [Char]] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ [[Char] -> Arg [Char]
forall e. e -> Arg e
defaultArg [Char]
"phi"] [Arg [Char]] -> [Arg [Char]] -> [Arg [Char]]
forall a. [a] -> [a] -> [a]
++ Tele (Dom Type) -> [Arg [Char]]
teleArgNames Tele (Dom Type)
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 (Tele (Dom Type)))
delta NamesT (TCMT IO) (AbsN (Tele (Dom Type)))
-> [NamesT (TCMT IO) (SubstArg (Tele (Dom Type)))]
-> NamesT (TCMT IO) (Tele (Dom Type))
forall (m :: * -> *) a.
(Monad m, Subst a) =>
NamesT m (AbsN a) -> [NamesT m (SubstArg a)] -> NamesT m a
`applyN` (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
    [Char]
-> NamesT (TCMT IO) Type
-> (Var (TCMT IO) -> NamesT (TCMT IO) (Tele (Dom Type)))
-> NamesT (TCMT IO) (Tele (Dom Type))
forall (m :: * -> *) a.
(Monad m, Abstract a) =>
[Char] -> NamesT m Type -> (Var m -> NamesT m a) -> NamesT m a
abstractT [Char]
"φ" (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) (Tele (Dom Type)))
 -> NamesT (TCMT IO) (Tele (Dom Type)))
-> (Var (TCMT IO) -> NamesT (TCMT IO) (Tele (Dom Type)))
-> NamesT (TCMT IO) (Tele (Dom Type))
forall a b. (a -> b) -> a -> b
$ \ Var (TCMT IO)
phi -> do
    NamesT (TCMT IO) (Tele (Dom Type))
-> (Vars (TCMT IO) -> NamesT (TCMT IO) (Tele (Dom Type)))
-> NamesT (TCMT IO) (Tele (Dom Type))
forall (m :: * -> *) a.
(Monad m, Abstract a) =>
NamesT m (Tele (Dom Type)) -> (Vars m -> NamesT m a) -> NamesT m a
abstractN (NamesT (TCMT IO) (AbsN (Tele (Dom Type)))
xTelI NamesT (TCMT IO) (AbsN (Tele (Dom Type)))
-> [NamesT (TCMT IO) (SubstArg (Tele (Dom Type)))]
-> NamesT (TCMT IO) (Tele (Dom Type))
forall (m :: * -> *) a.
(Monad m, Subst a) =>
NamesT m (AbsN a) -> [NamesT m (SubstArg a)] -> NamesT m a
`applyN` [NamesT (TCMT IO) Term]
[NamesT (TCMT IO) (SubstArg (Tele (Dom Type)))]
Vars (TCMT IO)
g1_args) ((Vars (TCMT IO) -> NamesT (TCMT IO) (Tele (Dom Type)))
 -> NamesT (TCMT IO) (Tele (Dom Type)))
-> (Vars (TCMT IO) -> NamesT (TCMT IO) (Tele (Dom Type)))
-> NamesT (TCMT IO) (Tele (Dom Type))
forall a b. (a -> b) -> a -> b
$ \ Vars (TCMT IO)
p -> do
    [NamesT (TCMT IO) Term]
-> NamesT (TCMT IO) Term
-> [NamesT (TCMT IO) Term]
-> NamesT (TCMT IO) (Tele (Dom Type))
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
    [Char]
-> (Var (TCMT IO)
    -> NamesT
         (TCMT IO)
         (AbsN (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term))))
-> NamesT
     (TCMT IO)
     (Abs (AbsN (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term))))
forall (m :: * -> *) a.
Monad m =>
[Char]
-> ((forall b. (Subst b, DeBruijn b) => NamesT m b) -> NamesT m a)
-> NamesT m (Abs a)
bind [Char]
"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
    [[Char]]
-> (Vars (TCMT IO)
    -> NamesT
         (TCMT IO) (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term)))
-> NamesT
     (TCMT IO)
     (AbsN (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term)))
forall (m :: * -> *) a.
Monad m =>
[[Char]] -> (Vars m -> NamesT m a) -> NamesT m (AbsN a)
bindN (Tele (Dom Type) -> [[Char]]
teleNames Tele (Dom Type)
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
    [[Char]]
-> (Vars (TCMT IO)
    -> NamesT (TCMT IO) ([NamedArg DeBruijnPattern], Dom Type, Term))
-> NamesT
     (TCMT IO) (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term))
forall (m :: * -> *) a.
Monad m =>
[[Char]] -> (Vars m -> NamesT m a) -> NamesT m (AbsN a)
bindN ((Arg [Char] -> [Char]) -> [Arg [Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map Arg [Char] -> [Char]
forall e. Arg e -> e
unArg ([Arg [Char]] -> [[Char]]) -> [Arg [Char]] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ [Arg [Char]]
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 (Tele (Dom Type))
-> NamesT (TCMT IO) (NamesT (TCMT IO) (Abs (Tele (Dom Type))))
forall (m :: * -> *) a.
(Monad m, Subst a) =>
a -> NamesT m (NamesT m a)
open (Abs (Tele (Dom Type))
 -> NamesT (TCMT IO) (NamesT (TCMT IO) (Abs (Tele (Dom Type)))))
-> NamesT (TCMT IO) (Abs (Tele (Dom Type)))
-> NamesT (TCMT IO) (NamesT (TCMT IO) (Abs (Tele (Dom Type))))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (NamesT (TCMT IO) (Abs (Tele (Dom Type)))
 -> NamesT (TCMT IO) (NamesT (TCMT IO) (Abs (Tele (Dom Type)))))
-> NamesT (TCMT IO) (Abs (Tele (Dom Type)))
-> NamesT (TCMT IO) (NamesT (TCMT IO) (Abs (Tele (Dom Type))))
forall a b. (a -> b) -> a -> b
$ [Char]
-> (Var (TCMT IO) -> NamesT (TCMT IO) (Tele (Dom Type)))
-> NamesT (TCMT IO) (Abs (Tele (Dom Type)))
forall (m :: * -> *) a.
Monad m =>
[Char]
-> ((forall b. (Subst b, DeBruijn b) => NamesT m b) -> NamesT m a)
-> NamesT m (Abs a)
bind [Char]
"i" ((Var (TCMT IO) -> NamesT (TCMT IO) (Tele (Dom Type)))
 -> NamesT (TCMT IO) (Abs (Tele (Dom Type))))
-> (Var (TCMT IO) -> NamesT (TCMT IO) (Tele (Dom Type)))
-> NamesT (TCMT IO) (Abs (Tele (Dom Type)))
forall a b. (a -> b) -> a -> b
$ \ Var (TCMT IO)
i -> do
      let ni :: NamesT (TCMT IO) Term
ni = NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall {m :: * -> *}.
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
NamesT m Term -> NamesT m Term
neg NamesT (TCMT IO) Term
Var (TCMT IO)
i
      dargs <- ((Term -> NamesT (TCMT IO) (NamesT (TCMT IO) Term))
-> [Term] -> NamesT (TCMT IO) [NamesT (TCMT IO) Term]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Term -> NamesT (TCMT IO) (NamesT (TCMT IO) Term)
forall (m :: * -> *) a.
(Monad m, Subst a) =>
a -> NamesT m (NamesT m a)
open ([Term] -> NamesT (TCMT IO) [NamesT (TCMT IO) Term])
-> NamesT (TCMT IO) [Term]
-> NamesT (TCMT IO) [NamesT (TCMT IO) Term]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (NamesT (TCMT IO) [Term]
 -> NamesT (TCMT IO) [NamesT (TCMT IO) Term])
-> NamesT (TCMT IO) [Term]
-> NamesT (TCMT IO) [NamesT (TCMT IO) Term]
forall a b. (a -> b) -> a -> b
$ do
        xs <- Abs [Term] -> Term -> [Term]
Abs [Term] -> SubstArg [Term] -> [Term]
forall a. Subst a => Abs a -> SubstArg a -> a
absApp (Abs [Term] -> Term -> [Term])
-> NamesT (TCMT IO) (Abs [Term])
-> NamesT (TCMT IO) (Term -> [Term])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamesT (TCMT IO) (Abs [Term])
g1_left NamesT (TCMT IO) (Term -> [Term])
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) [Term]
forall a b.
NamesT (TCMT IO) (a -> b)
-> NamesT (TCMT IO) a -> NamesT (TCMT IO) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> NamesT (TCMT IO) Term
ni
        y <- absApp <$> pat_left <*> ni
        return $ xs ++ [y]
      delta `applyN` dargs

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

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


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

    sys <- do
      sides <- do
        neg <- primINeg
        io <- primIOne
        vs <- iApplyVars <$> ps
        tm <- w
        xs <- forM vs $ \ Int
v ->
            -- have to reduce these under the appropriate substitutions, otherwise non-normalizing(?)
              ((Abs Term, Abs Term) -> (Term, (Abs Term, Abs Term)))
-> NamesT (TCMT IO) (Abs Term, Abs Term)
-> NamesT (TCMT IO) (Term, (Abs Term, Abs Term))
forall a b. (a -> b) -> NamesT (TCMT IO) a -> NamesT (TCMT IO) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Term
var Int
v,) (NamesT (TCMT IO) (Abs Term, Abs Term)
 -> NamesT (TCMT IO) (Term, (Abs Term, Abs Term)))
-> ((Abs Term, Abs Term) -> NamesT (TCMT IO) (Abs Term, Abs Term))
-> (Abs Term, Abs Term)
-> NamesT (TCMT IO) (Term, (Abs Term, Abs Term))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Abs Term, Abs Term) -> NamesT (TCMT IO) (Abs Term, Abs Term)
forall a (m :: * -> *). (Reduce a, MonadReduce m) => a -> m a
reduce ((Abs Term, Abs Term)
 -> NamesT (TCMT IO) (Term, (Abs Term, Abs Term)))
-> (Abs Term, Abs Term)
-> NamesT (TCMT IO) (Term, (Abs Term, Abs Term))
forall a b. (a -> b) -> a -> b
$ (Int -> Term -> Substitution' 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 -> [Arg Term] -> Term
forall t. Apply t => t -> [Arg Term] -> t
`apply` [Term -> Arg Term
forall e. e -> Arg e
argN Term
v],Abs Term
l),(Term
v,Abs Term
r)]) xs
      forM sides $ \ (Term
psi,Abs Term
u') -> do
        u' <- Abs Term -> NamesT (TCMT IO) (NamesT (TCMT IO) (Abs Term))
forall (m :: * -> *) a.
(Monad m, Subst a) =>
a -> NamesT m (NamesT m a)
open Abs Term
u'
        u <- lam "i" $ \ NamesT (TCMT IO) Term
i -> [Char]
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall (m :: * -> *).
Monad m =>
[Char] -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
ilam [Char]
"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 :: Tele (Dom Type)
clauseTel       = Tele (Dom Type)
cTel
                  , namedClausePats :: [NamedArg DeBruijnPattern]
namedClausePats = [NamedArg DeBruijnPattern]
ps
                  , clauseBody :: Maybe Term
clauseBody      = Term -> Maybe Term
forall a. a -> Maybe a
Just Term
rhs
                  , clauseType :: Maybe (Arg Type)
clauseType      = Arg Type -> Maybe (Arg Type)
forall a. a -> Maybe a
Just (Arg Type -> Maybe (Arg Type)) -> Arg Type -> Maybe (Arg Type)
forall a b. (a -> b) -> a -> b
$ ArgInfo -> Type -> Arg Type
forall e. ArgInfo -> e -> Arg e
Arg (Dom Type -> ArgInfo
forall a. LensArgInfo a => a -> ArgInfo
getArgInfo Dom Type
ty) (Dom Type -> Type
forall t e. Dom' t e -> e
unDom Dom Type
ty)
                  , clauseCatchall :: Catchall
clauseCatchall    = Catchall
forall a. Null a => a
empty
                  , clauseRecursive :: ClauseRecursive
clauseRecursive   = ClauseRecursive
YesRecursive
                  , clauseUnreachable :: Maybe Bool
clauseUnreachable = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False
                  , clauseEllipsis :: ExpandedEllipsis
clauseEllipsis    = ExpandedEllipsis
NoEllipsis
                  , clauseWhereModule :: Maybe ModuleName
clauseWhereModule = Maybe ModuleName
forall a. Maybe a
Nothing
                  }


  debugClause "tc.cover.trxcon" cl

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

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

  return cl

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

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

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

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

-- | Append an hcomp clause to the clauses of a function.
createMissingHCompClause ::
     QName
       -- ^ Function name.
  -> Arg Nat
       -- ^ index of hcomp pattern
  -> BlockingVar
       -- ^ Blocking var that lead to hcomp split.
  -> SplitClause
       -- ^ Clause before the hcomp split
  -> SplitClause
       -- ^ Clause to add.
  -> [Clause]
   -> TCM ([(SplitTag,CoverResult)], [Clause])
createMissingHCompClause :: QName
-> Arg Int
-> BlockingVar
-> SplitClause
-> SplitClause
-> [Clause]
-> TCM ([(SplitTag, CoverResult)], [Clause])
createMissingHCompClause QName
f Arg Int
n BlockingVar
x SplitClause
old_sc (SClause Tele (Dom Type)
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
  [Char] -> Int -> TCMT IO Doc -> TCMT IO ()
forall (m :: * -> *).
MonadDebug m =>
[Char] -> Int -> TCMT IO Doc -> m ()
reportSDoc [Char]
"tc.cover.hcomp" Int
20 (TCMT IO Doc -> TCMT IO ()) -> TCMT IO Doc -> TCMT IO ()
forall a b. (a -> b) -> a -> b
$ Tele (Dom Type) -> TCMT IO Doc -> TCMT IO Doc
forall b (m :: * -> *) a.
(AddContext b, MonadAddContext m) =>
b -> m a -> m a
forall (m :: * -> *) a.
MonadAddContext m =>
Tele (Dom Type) -> m a -> m a
addContext Tele (Dom Type)
tel (TCMT IO Doc -> TCMT IO Doc) -> TCMT IO Doc -> TCMT IO Doc
forall a b. (a -> b) -> a -> b
$ [Char] -> TCMT IO Doc
forall (m :: * -> *). Applicative m => [Char] -> m Doc
text [Char]
"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
  [Char] -> Int -> TCMT IO Doc -> TCMT IO ()
forall (m :: * -> *).
MonadDebug m =>
[Char] -> Int -> TCMT IO Doc -> m ()
reportSDoc [Char]
"tc.cover.hcomp" Int
30 (TCMT IO Doc -> TCMT IO ()) -> TCMT IO Doc -> TCMT IO ()
forall a b. (a -> b) -> a -> b
$ Tele (Dom Type) -> TCMT IO Doc -> TCMT IO Doc
forall b (m :: * -> *) a.
(AddContext b, MonadAddContext m) =>
b -> m a -> m a
forall (m :: * -> *) a.
MonadAddContext m =>
Tele (Dom Type) -> m a -> m a
addContext Tele (Dom Type)
tel (TCMT IO Doc -> TCMT IO Doc) -> TCMT IO Doc -> TCMT IO Doc
forall a b. (a -> b) -> a -> b
$ [Char] -> TCMT IO Doc
forall (m :: * -> *). Applicative m => [Char] -> m Doc
text [Char]
"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)
  [Char] -> Int -> TCMT IO Doc -> TCMT IO ()
forall (m :: * -> *).
MonadDebug m =>
[Char] -> Int -> TCMT IO Doc -> m ()
reportSDoc [Char]
"tc.cover.hcomp" Int
30 (TCMT IO Doc -> TCMT IO ()) -> TCMT IO Doc -> TCMT IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> TCMT IO Doc
forall (m :: * -> *). Applicative m => [Char] -> m Doc
text [Char]
"tel = " TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> Tele (Dom Type) -> TCMT IO Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
forall (m :: * -> *). MonadPretty m => Tele (Dom Type) -> m Doc
prettyTCM Tele (Dom Type)
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
-> (Tele (Dom Type), [NamedArg DeBruijnPattern])
-> Doc
-> Closure (Abs Type)
-> SplitError
CannotCreateMissingClause QName
f (Tele (Dom Type)
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 -> Tele (Dom Type)
scTel SplitClause
old_sc
      -- old_tel = Γ(x:H)Δ
      -- Γ(x:H)Δ ⊢ old_t
      -- vs = iApplyVars old_ps
      -- [ α ⇒ b ] = [(i,f old_ps (i=0),f old_ps (i=1)) | i <- vs]

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

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

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

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

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

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

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

  -- Γ(x:H)(δ : Δ) ⊢ [ α ⇒ b ] = [(i,f old_ps (i=0),f old_ps (i=1)) | i <- vs]
  alphab <- forM vs $ \ Int
i -> do
               let
                 -- Γ(x:H)(δ : Δ) ⊢
                 tm :: Term
tm = QName -> [Elim] -> Term
Def QName
f [Elim]
old_ps
               -- TODO only reduce IApply _ _ (0/1), as to avoid termination problems
               (l,r) <- (Term, Term) -> TCMT IO (Term, Term)
forall a (m :: * -> *). (Reduce a, MonadReduce m) => a -> m a
reduce (Int -> Term -> Substitution' 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 (Tele (Dom Type)))
a t (TCMT IO) Term
b t (TCMT IO) [Arg Term]
c t (TCMT IO) Term
d = do
              m <- Abs (Tele (Dom Type))
-> Term
-> [Arg Term]
-> Term
-> ExceptT (Closure (Abs Type)) (TCMT IO) [Arg Term]
trFillTel (Abs (Tele (Dom Type))
 -> Term
 -> [Arg Term]
 -> Term
 -> ExceptT (Closure (Abs Type)) (TCMT IO) [Arg Term])
-> t (TCMT IO) (Abs (Tele (Dom Type)))
-> t (TCMT IO)
     (Term
      -> [Arg Term]
      -> Term
      -> ExceptT (Closure (Abs Type)) (TCMT IO) [Arg Term])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> t (TCMT IO) (Abs (Tele (Dom Type)))
a t (TCMT IO)
  (Term
   -> [Arg Term]
   -> Term
   -> ExceptT (Closure (Abs Type)) (TCMT IO) [Arg Term])
-> t (TCMT IO) Term
-> t (TCMT IO)
     ([Arg Term]
      -> Term -> ExceptT (Closure (Abs Type)) (TCMT IO) [Arg Term])
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)
  ([Arg Term]
   -> Term -> ExceptT (Closure (Abs Type)) (TCMT IO) [Arg Term])
-> t (TCMT IO) [Arg Term]
-> t (TCMT IO)
     (Term -> ExceptT (Closure (Abs Type)) (TCMT IO) [Arg Term])
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) [Arg Term]
c t (TCMT IO)
  (Term -> ExceptT (Closure (Abs Type)) (TCMT IO) [Arg Term])
-> t (TCMT IO) Term
-> t (TCMT IO) (ExceptT (Closure (Abs Type)) (TCMT IO) [Arg Term])
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) [Arg Term]
forall (m :: * -> *) a.
MonadTCError m =>
Doc -> Closure (Abs Type) -> m a
cannotCreate Doc
"Cannot transport with type family:" Closure (Abs Type)
bad_t
                Right [Arg Term]
args -> [Arg Term] -> t (TCMT IO) [Arg Term]
forall a. a -> t (TCMT IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return [Arg Term]
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))
                                               ([Char]
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall (m :: * -> *).
Monad m =>
[Char] -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
lam [Char]
"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
<#> [Char]
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall (m :: * -> *).
Monad m =>
[Char] -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
ilam [Char]
"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
<@> [Char]
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall (m :: * -> *).
Monad m =>
[Char] -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
ilam [Char]
"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
<@> [Char]
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall (m :: * -> *).
Monad m =>
[Char] -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
ilam [Char]
"o" (\ NamesT (TCMT IO) Term
_ -> NamesT (TCMT IO) Term
u0)
                                                   )
                                               NamesT (TCMT IO) Term
u0
          -- Γ,φ,u,u0,(δ : Δ(x = hcomp φ u u0)) ⊢ hcompS : Γ(x:H)(δ : Δ)
          hcompS <- lift $ do
            hdom <- pure $ raise 3 hdom
            let
              [phi,u,u0] = map (pure . var) [2,1,0]
              htype = Term -> TCMT IO Term
forall a. a -> TCMT IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term -> TCMT IO Term) -> Term -> TCMT IO Term
forall a b. (a -> b) -> a -> b
$ Type -> Term
forall t a. Type'' t a -> a
unEl (Type -> Term) -> (Dom Type -> Type) -> Dom Type -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dom Type -> Type
forall t e. Dom' t e -> e
unDom (Dom Type -> Term) -> Dom Type -> Term
forall a b. (a -> b) -> a -> b
$ Dom Type
hdom
              lvl = Type -> TCMT IO Term
getLevel (Type -> TCMT IO Term) -> Type -> TCMT IO Term
forall a b. (a -> b) -> a -> b
$ Dom Type -> Type
forall t e. Dom' t e -> e
unDom Dom Type
hdom
            hc <- pure tHComp <#> lvl <#> htype
                                      <#> phi
                                      <@> u
                                      <@> u0
            return $ liftS (size delta) $ hc `consS` raiseS 3
          -- Γ,φ,u,u0,Δ(x = hcomp phi u u0) ⊢ raise 3+|Δ| hdom
          hdom <- pure $ raise (3 + size delta) hdom
          htype <- open $ unEl . unDom $ hdom
          lvl <- open =<< (lift . getLevel $ unDom hdom)

          -- Γ,φ,u,u0,Δ(x = hcomp phi u u0) ⊢
          let vr = Term -> NamesT (TCMT IO) (NamesT (TCMT IO) Term)
forall (m :: * -> *) a.
(Monad m, Subst a) =>
a -> NamesT m (NamesT m a)
open (Term -> NamesT (TCMT IO) (NamesT (TCMT IO) Term))
-> (Int -> Term) -> Int -> NamesT (TCMT IO) (NamesT (TCMT IO) Term)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Term -> Term
forall a. Subst a => Int -> a -> a
raise (Abs (Tele (Dom Type)) -> Int
forall a. Sized a => a -> Int
size Abs (Tele (Dom Type))
delta) (Term -> Term) -> (Int -> Term) -> Int -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Term
var
          phi <- vr 2
          u   <- vr 1
          u0  <- vr 0
          -- Γ,x,Δ ⊢ f old_ps
          -- Γ ⊢ abstract hdelta (f old_ps)
          g <- open $ raise (3 + size delta) $ abstract hdelta (Def f old_ps)
          old_t <- open $ raise (3 + size delta) $ abstract hdelta (unDom old_t)
          let bapp f (Abs b)
a f (SubstArg b)
x = Abs b -> SubstArg b -> b
forall a. Subst a => Abs a -> SubstArg a -> a
lazyAbsApp (Abs b -> SubstArg b -> b) -> f (Abs b) -> f (SubstArg b -> b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (Abs b)
a f (SubstArg b -> b) -> f (SubstArg b) -> f b
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f (SubstArg b)
x
          (delta_fill :: NamesT TCM (Abs Args)) <- (open =<<) $ do
            -- Γ,φ,u,u0,Δ(x = hcomp phi u u0) ⊢ x.Δ
            delta <- open $ raise (3 + size delta) delta
            -- Γ,φ,u,u0,Δ(x = hcomp phi u u0) ⊢ i.Δ(x = hfill phi u u0 (~ i))
            deltaf <- open =<< bind "i" (\ Var (TCMT IO)
i ->
                           (NamesT (TCMT IO) (Abs (Tele (Dom Type)))
delta NamesT (TCMT IO) (Abs (Tele (Dom Type)))
-> NamesT (TCMT IO) (SubstArg (Tele (Dom Type)))
-> NamesT (TCMT IO) (Tele (Dom Type))
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 -> [Char]
-> NamesT (TCMT IO) [Arg Term] -> NamesT (TCMT IO) [Arg Term]
forall b (m :: * -> *) a.
(AddContext b, MonadAddContext m) =>
b -> m a -> m a
forall (m :: * -> *) a. MonadAddContext m => [Char] -> m a -> m a
addContext ([Char]
"i" :: String) (NamesT (TCMT IO) [Arg Term] -> NamesT (TCMT IO) [Arg Term])
-> NamesT (TCMT IO) [Arg Term] -> NamesT (TCMT IO) [Arg Term]
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 (Tele (Dom Type)))
-> NamesT (TCMT IO) Term
-> NamesT (TCMT IO) [Arg Term]
-> NamesT (TCMT IO) Term
-> NamesT (TCMT IO) [Arg Term]
forall {t :: (* -> *) -> * -> *}.
(MonadTrans t, MonadTCEnv (t (TCMT IO)), ReadTCState (t (TCMT IO)),
 MonadError TCErr (t (TCMT IO))) =>
t (TCMT IO) (Abs (Tele (Dom Type)))
-> t (TCMT IO) Term
-> t (TCMT IO) [Arg Term]
-> t (TCMT IO) Term
-> t (TCMT IO) [Arg Term]
trFillTel' NamesT (TCMT IO) (Abs (Tele (Dom Type)))
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) [Arg Term]
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 -> [Arg Term] -> Term
forall t. Apply t => t -> [Arg Term] -> t
apply (Term -> [Arg Term] -> Term)
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) ([Arg Term] -> Term)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamesT (TCMT IO) Term
f NamesT (TCMT IO) ([Arg Term] -> Term)
-> NamesT (TCMT IO) [Arg 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) (Abs [Arg Term])
delta_fill NamesT (TCMT IO) (Abs [Arg Term])
-> NamesT (TCMT IO) (SubstArg [Arg Term])
-> NamesT (TCMT IO) [Arg Term]
forall {f :: * -> *} {b}.
(Applicative f, Subst b) =>
f (Abs b) -> f (SubstArg b) -> f b
`bapp` NamesT (TCMT IO) Term
NamesT (TCMT IO) (SubstArg [Arg Term])
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.
(Monad m, Subst a) =>
a -> NamesT m (NamesT m a)
open (Term -> NamesT (TCMT IO) (NamesT (TCMT IO) Term))
-> NamesT (TCMT IO) Term
-> NamesT (TCMT IO) (NamesT (TCMT IO) Term)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [Char]
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall (m :: * -> *).
Monad m =>
[Char] -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
lam [Char]
"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
<#> [Char]
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall (m :: * -> *).
Monad m =>
[Char] -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
ilam [Char]
"o" (\ NamesT (TCMT IO) Term
_ -> Type -> Term
forall t a. Type'' t a -> a
unEl (Type -> Term) -> NamesT (TCMT IO) Type -> NamesT (TCMT IO) Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
ty NamesT (TCMT IO) Term
i) NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT (TCMT IO) Term
u0 NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT (TCMT IO) Term
u1
          alpha <- do
            vars <- mapM (open . applySubst hcompS . fst) alphab
            return $ foldr (imax . (\ NamesT (TCMT IO) Term
v -> NamesT (TCMT IO) Term
v NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
`imax` NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
ineg NamesT (TCMT IO) Term
v)) (pure iz) vars

          -- Γ,φ,u,u0,Δ(x = hcomp φ u u0) ⊢ b : (i : I) → [α] -> old_t[x = hfill φ u u0 i,δ_fill[i]]
          b <- do
             sides <- forM alphab $ \ (Term
psi,(Term
side0,Term
side1)) -> do
                psi <- Term -> NamesT (TCMT IO) (NamesT (TCMT IO) Term)
forall (m :: * -> *) a.
(Monad m, Subst a) =>
a -> NamesT m (NamesT m a)
open (Term -> NamesT (TCMT IO) (NamesT (TCMT IO) Term))
-> Term -> NamesT (TCMT IO) (NamesT (TCMT IO) Term)
forall a b. (a -> b) -> a -> b
$ Substitution' Term
Substitution' (SubstArg Term)
hcompS Substitution' (SubstArg Term) -> Term -> Term
forall a. Subst a => Substitution' (SubstArg a) -> a -> a
`applySubst` Term
psi
                let f = Term -> NamesT (TCMT IO) (NamesT (TCMT IO) Term)
forall (m :: * -> *) a.
(Monad m, Subst a) =>
a -> NamesT m (NamesT m a)
open (Term -> NamesT (TCMT IO) (NamesT (TCMT IO) Term))
-> (Term -> Term)
-> Term
-> NamesT (TCMT IO) (NamesT (TCMT IO) Term)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Term -> Term
forall a. Subst a => Int -> a -> a
raise (Int
3 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Abs (Tele (Dom Type)) -> Int
forall a. Sized a => a -> Int
size Abs (Tele (Dom Type))
delta) (Term -> Term) -> (Term -> Term) -> Term -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tele (Dom Type) -> Term -> Term
forall t. Abstract t => Tele (Dom Type) -> t -> t
abstract Tele (Dom Type)
hdelta
                side0 <- f side0
                side1 <- f side1
                return $ (ineg psi `imax` psi, \ NamesT (TCMT IO) Term
i -> NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term
pOr_ty NamesT (TCMT IO) Term
i (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
ineg NamesT (TCMT IO) Term
psi) NamesT (TCMT IO) Term
psi ([Char]
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall (m :: * -> *).
Monad m =>
[Char] -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
ilam [Char]
"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)
                                                            ([Char]
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall (m :: * -> *).
Monad m =>
[Char] -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
ilam [Char]
"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 = ([Char]
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall (m :: * -> *).
Monad m =>
[Char] -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
ilam [Char]
"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 = Tele (Dom Type) -> Int
forall a. Sized a => a -> Int
size Tele (Dom Type)
tel Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Tele (Dom Type) -> Int
forall a. Sized a => a -> Int
size Tele (Dom Type)
gamma Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Abs (Tele (Dom Type)) -> Int
forall a. Sized a => a -> Int
size Abs (Tele (Dom Type))
delta)
    reportSDoc "tc.cover.hcomp" 20 $ text "n =" <+> text (show n)
    (TelV deltaEx t,bs) <- telViewUpToPathBoundary' n ty
    rhs <- pure $ raise n rhs `applyE` teleElims deltaEx bs

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

    return $ Clause { clauseLHSRange  = noRange
                    , clauseFullRange = noRange
                    , clauseTel       = tel
                    , namedClausePats = fromSplitPatterns ps
                    , clauseBody      = Just $ rhs
                    , clauseType      = Just $ defaultArg t
                    , clauseCatchall    = empty
                    , clauseRecursive   = MaybeRecursive     -- TODO: can it be recursive?
                    , clauseUnreachable = Just False  -- missing, thus, not unreachable
                    , clauseEllipsis    = NoEllipsis
                    , clauseWhereModule = Nothing
                    }
  addClauses f [cl]  -- Important: add at the end.
  let result = CoverResult
          { coverSplitTree :: SplitTree' SplitTag
coverSplitTree      = Int -> SplitTree' SplitTag
forall a. Int -> SplitTree' a
SplittingDone (Tele (Dom Type) -> Int
forall a. Sized a => a -> Int
size (Clause -> Tele (Dom Type)
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 :: [(Tele (Dom Type), [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 Tele (Dom Type)
_ [NamedArg SplitPattern]
_ Substitution' SplitPattern
_ Map CheckpointId (Substitution' Term)
_ Maybe (Dom Type)
Nothing) [Clause]
_ = TCM ([(SplitTag, CoverResult)], [Clause])
forall a. HasCallStack => a
__IMPOSSIBLE__