{-# LANGUAGE NondecreasingIndentation #-}

module Agda.TypeChecking.Coverage.Cubical where

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

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

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

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

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

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

import Agda.Utils.Impossible


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

         Bool -> TCMT IO () -> TCMT IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([(SplitTag, (SplitClause, IInfo))] -> Int
forall a. Sized a => a -> Int
size [(SplitTag, (SplitClause, IInfo))]
xs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [(QName, UnifyEquiv)] -> Int
forall a. Sized a => a -> Int
size [(QName, UnifyEquiv)]
infos) (TCMT IO () -> TCMT IO ()) -> TCMT IO () -> TCMT IO ()
forall a b. (a -> b) -> a -> b
$
            String -> Int -> TCMT IO Doc -> TCMT IO ()
forall (m :: * -> *).
MonadDebug m =>
String -> Int -> TCMT IO Doc -> m ()
reportSDoc String
"tc.cover.indexed" Int
20 (TCMT IO Doc -> TCMT IO ()) -> TCMT IO Doc -> TCMT IO ()
forall a b. (a -> b) -> a -> b
$ String -> TCMT IO Doc
forall (m :: * -> *). Applicative m => String -> m Doc
text String
"missing some infos"
            -- Andrea: what to do when we only managed to build a unification proof for some of the constructors?
         Constructor{QName
conData :: QName
conData :: Defn -> QName
conData} <- Definition -> Defn
theDef (Definition -> Defn) -> TCMT IO Definition -> TCMT IO Defn
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> QName -> TCMT IO Definition
forall (m :: * -> *). HasConstInfo m => QName -> m Definition
getConstInfo ((QName, UnifyEquiv) -> QName
forall a b. (a, b) -> a
fst (QName, UnifyEquiv)
info)
         Datatype{dataPars :: Defn -> Int
dataPars = Int
pars, dataIxs :: Defn -> Int
dataIxs = Int
nixs, Maybe QName
dataTranspIx :: Maybe QName
dataTranspIx :: Defn -> Maybe QName
dataTranspIx} <- Definition -> Defn
theDef (Definition -> Defn) -> TCMT IO Definition -> TCMT IO Defn
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> QName -> TCMT IO Definition
forall (m :: * -> *). HasConstInfo m => QName -> m Definition
getConstInfo QName
conData
         QName
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
         QName
trX <- 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
<$> Maybe QName -> TCMT IO (Maybe QName)
forall a. a -> TCMT IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe QName
dataTranspIx
         Clause
trX_cl <- QName
-> QName -> Arg Int -> BlockingVar -> SplitClause -> TCM Clause
createMissingTrXTrXClause QName
trX QName
f Arg Int
n BlockingVar
x SplitClause
old_sc
         Clause
hcomp_cl <- QName
-> QName -> Arg Int -> BlockingVar -> SplitClause -> TCM Clause
createMissingTrXHCompClause QName
trX QName
f Arg Int
n BlockingVar
x SplitClause
old_sc
         ([(SplitTag, SplitTree' SplitTag)]
trees,[Clause]
cls) <- ([((SplitTag, SplitTree' SplitTag), Clause)]
 -> ([(SplitTag, SplitTree' SplitTag)], [Clause]))
-> TCMT IO [((SplitTag, SplitTree' SplitTag), Clause)]
-> TCMT IO ([(SplitTag, SplitTree' SplitTag)], [Clause])
forall a b. (a -> b) -> TCMT IO a -> TCMT IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [((SplitTag, SplitTree' SplitTag), Clause)]
-> ([(SplitTag, SplitTree' SplitTag)], [Clause])
forall a b. [(a, b)] -> ([a], [b])
unzip (TCMT IO [((SplitTag, SplitTree' SplitTag), Clause)]
 -> TCMT IO ([(SplitTag, SplitTree' SplitTag)], [Clause]))
-> (((QName, UnifyEquiv)
     -> TCMT IO ((SplitTag, SplitTree' SplitTag), Clause))
    -> TCMT IO [((SplitTag, SplitTree' SplitTag), Clause)])
-> ((QName, UnifyEquiv)
    -> TCMT IO ((SplitTag, SplitTree' SplitTag), Clause))
-> TCMT IO ([(SplitTag, SplitTree' SplitTag)], [Clause])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(QName, UnifyEquiv)]
-> ((QName, UnifyEquiv)
    -> TCMT IO ((SplitTag, SplitTree' SplitTag), Clause))
-> TCMT IO [((SplitTag, SplitTree' SplitTag), Clause)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [(QName, UnifyEquiv)]
infos (((QName, UnifyEquiv)
  -> TCMT IO ((SplitTag, SplitTree' SplitTag), Clause))
 -> TCMT IO ([(SplitTag, SplitTree' SplitTag)], [Clause]))
-> ((QName, UnifyEquiv)
    -> TCMT IO ((SplitTag, SplitTree' SplitTag), Clause))
-> TCMT IO ([(SplitTag, SplitTree' SplitTag)], [Clause])
forall a b. (a -> b) -> a -> b
$ \ (QName
c,UnifyEquiv
i) -> do
           Clause
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
           ((SplitTag, SplitTree' SplitTag), Clause)
-> TCMT IO ((SplitTag, SplitTree' SplitTag), Clause)
forall a. a -> TCMT IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (((SplitTag, SplitTree' SplitTag), Clause)
 -> TCMT IO ((SplitTag, SplitTree' SplitTag), Clause))
-> ((SplitTag, SplitTree' SplitTag), Clause)
-> TCMT IO ((SplitTag, SplitTree' SplitTag), Clause)
forall a b. (a -> b) -> a -> b
$ ((QName -> SplitTag
SplitCon QName
c , Int -> SplitTree' SplitTag
forall a. Int -> SplitTree' a
SplittingDone (Telescope -> Int
forall a. Sized a => a -> Int
size (Telescope -> Int) -> Telescope -> Int
forall a b. (a -> b) -> a -> b
$ Clause -> Telescope
clauseTel Clause
cl)) , Clause
cl)
         let extra :: [(SplitTag, SplitTree' SplitTag)]
extra = [ (QName -> SplitTag
SplitCon QName
trX, Int -> SplitTree' SplitTag
forall a. Int -> SplitTree' a
SplittingDone (Int -> SplitTree' SplitTag) -> Int -> SplitTree' SplitTag
forall a b. (a -> b) -> a -> b
$ Telescope -> Int
forall a. Sized a => a -> Int
size (Telescope -> Int) -> Telescope -> Int
forall a b. (a -> b) -> a -> b
$ Clause -> Telescope
clauseTel Clause
trX_cl)
                                           , (QName -> SplitTag
SplitCon QName
hcomp, Int -> SplitTree' SplitTag
forall a. Int -> SplitTree' a
SplittingDone (Int -> SplitTree' SplitTag) -> Int -> SplitTree' SplitTag
forall a b. (a -> b) -> a -> b
$ Telescope -> Int
forall a. Sized a => a -> Int
size (Telescope -> Int) -> Telescope -> Int
forall a b. (a -> b) -> a -> b
$ Clause -> Telescope
clauseTel Clause
hcomp_cl)
                                           ]
                 --  = [ (SplitCon trX, SplittingDone $ size $ clauseTel trX_cl) ]
             extraCl :: [Clause]
extraCl = [Clause
trX_cl, Clause
hcomp_cl]
                 --  = [trX_cl]
         let clauses :: [Clause]
clauses = [Clause]
cls [Clause] -> [Clause] -> [Clause]
forall a. [a] -> [a] -> [a]
++ [Clause]
extraCl
         let tree :: SplitTree' SplitTag
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
res = CoverResult
               { coverSplitTree :: SplitTree' SplitTag
coverSplitTree      = SplitTree' SplitTag
tree
               , coverUsedClauses :: IntSet
coverUsedClauses    = let l :: Int
l = [Clause] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Clause]
cs in [Int] -> IntSet
IntSet.fromAscList [Int
l .. Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [Clause] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Clause]
clauses Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]
               , coverMissingClauses :: [(Telescope, [NamedArg DeBruijnPattern])]
coverMissingClauses = []
               , coverPatterns :: [Clause]
coverPatterns       = [Clause]
clauses
               , coverNoExactClauses :: IntSet
coverNoExactClauses = IntSet
IntSet.empty
               }
         String -> Int -> TCMT IO Doc -> TCMT IO ()
forall (m :: * -> *).
MonadDebug m =>
String -> Int -> TCMT IO Doc -> m ()
reportSDoc String
"tc.cover.indexed" Int
20 (TCMT IO Doc -> TCMT IO ()) -> TCMT IO Doc -> TCMT IO ()
forall a b. (a -> b) -> a -> b
$
           TCMT IO Doc
"tree:" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> SplitTree' SplitTag -> TCMT IO Doc
forall (m :: * -> *) a. (Applicative m, Pretty a) => a -> m Doc
pretty SplitTree' SplitTag
tree
         QName -> [Clause] -> TCMT IO ()
forall (m :: * -> *).
(MonadConstraint m, MonadTCState m) =>
QName -> [Clause] -> m ()
addClauses QName
f [Clause]
clauses
         ([(SplitTag, CoverResult)], [Clause])
-> TCM ([(SplitTag, CoverResult)], [Clause])
forall a. a -> TCMT IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([(QName -> SplitTag
SplitCon QName
trX, CoverResult
res)], [Clause]
cs [Clause] -> [Clause] -> [Clause]
forall a. [a] -> [a] -> [a]
++ [Clause]
clauses)
    [(SplitTag, (SplitClause, IInfo))]
xs | Bool
otherwise -> ([(SplitTag, CoverResult)], [Clause])
-> TCM ([(SplitTag, CoverResult)], [Clause])
forall a. a -> TCMT IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([], [Clause]
cs)

covFillTele :: QName -> Abs Telescope -> Term -> Args -> Term -> TCM [Term]
covFillTele :: QName -> Abs Telescope -> Term -> Args -> Term -> TCM [Term]
covFillTele QName
func Abs Telescope
tel Term
face Args
d Term
j = do
  Either (Closure (Abs Type)) Args
ed_f <- TCM (Either (Closure (Abs Type)) Args)
-> TCM (Either (Closure (Abs Type)) Args)
forall a. TCM a -> TCM a
forall (tcm :: * -> *) a. MonadTCM tcm => TCM a -> tcm a
liftTCM (TCM (Either (Closure (Abs Type)) Args)
 -> TCM (Either (Closure (Abs Type)) Args))
-> TCM (Either (Closure (Abs Type)) Args)
-> TCM (Either (Closure (Abs Type)) Args)
forall a b. (a -> b) -> a -> b
$ ExceptT (Closure (Abs Type)) (TCMT IO) Args
-> TCM (Either (Closure (Abs Type)) Args)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT (Closure (Abs Type)) (TCMT IO) Args
 -> TCM (Either (Closure (Abs Type)) Args))
-> ExceptT (Closure (Abs Type)) (TCMT IO) Args
-> TCM (Either (Closure (Abs Type)) Args)
forall a b. (a -> b) -> a -> b
$ Abs Telescope
-> Term
-> Args
-> Term
-> ExceptT (Closure (Abs Type)) (TCMT IO) Args
trFillTel Abs Telescope
tel Term
face Args
d Term
j
  case Either (Closure (Abs Type)) Args
ed_f of
    Right Args
d_f -> [Term] -> TCM [Term]
forall a. a -> TCMT IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Term] -> TCM [Term]) -> [Term] -> TCM [Term]
forall a b. (a -> b) -> a -> b
$ (Arg Term -> Term) -> Args -> [Term]
forall a b. (a -> b) -> [a] -> [b]
map Arg Term -> Term
forall e. Arg e -> e
unArg Args
d_f
    Left Closure (Abs Type)
failed_t -> Closure (Abs Type) -> (Abs Type -> TCM [Term]) -> TCM [Term]
forall (m :: * -> *) c a b.
(MonadTCEnv m, ReadTCState m, LensClosure c a) =>
c -> (a -> m b) -> m b
enterClosure Closure (Abs Type)
failed_t ((Abs Type -> TCM [Term]) -> TCM [Term])
-> (Abs Type -> TCM [Term]) -> TCM [Term]
forall a b. (a -> b) -> a -> b
$ \Abs Type
failed_t -> (String, Dom Type) -> TCM [Term] -> TCM [Term]
forall b (m :: * -> *) a.
(AddContext b, MonadAddContext m) =>
b -> m a -> m a
forall (m :: * -> *) a.
MonadAddContext m =>
(String, Dom Type) -> m a -> m a
addContext (String
"i" :: String, Dom Type
HasCallStack => Dom Type
__DUMMY_DOM__) (TCM [Term] -> TCM [Term]) -> TCM [Term] -> TCM [Term]
forall a b. (a -> b) -> a -> b
$ do
      TypeError -> TCM [Term]
forall (m :: * -> *) a.
(HasCallStack, MonadTCError m) =>
TypeError -> m a
typeError (TypeError -> TCM [Term])
-> (Doc -> TypeError) -> Doc -> TCM [Term]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> TypeError
GenericDocError (Doc -> TCM [Term]) -> TCMT IO Doc -> TCM [Term]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [TCMT IO Doc] -> TCMT IO Doc
forall (m :: * -> *) (t :: * -> *).
(Applicative m, Foldable t) =>
t (m Doc) -> m Doc
vcat
        [ TCMT IO Doc
"Could not generate a transport clause for" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> QName -> TCMT IO Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
forall (m :: * -> *). MonadPretty m => QName -> m Doc
prettyTCM QName
func
        , TCMT IO Doc
"because a term of type" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> Type -> TCMT IO Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
forall (m :: * -> *). MonadPretty m => Type -> m Doc
prettyTCM (Abs Type -> Type
forall a. Abs a -> a
unAbs Abs Type
failed_t)
        , TCMT IO Doc
"lives in the sort" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> Sort -> TCMT IO Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
forall (m :: * -> *). MonadPretty m => Sort -> m Doc
prettyTCM (Type -> Sort
forall a. LensSort a => a -> Sort
getSort (Abs Type -> Type
forall a. Abs a -> a
unAbs Abs Type
failed_t)) TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> TCMT IO Doc
"and thus can not be transported"
        ]

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

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

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

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

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

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

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

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

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

  AbsN [(Term, Term)]
old_sides <- AbsN [NamedArg DeBruijnPattern]
-> ([NamedArg DeBruijnPattern] -> TCMT IO [(Term, Term)])
-> TCMT IO (AbsN [(Term, Term)])
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM AbsN [NamedArg DeBruijnPattern]
old_ps' (([NamedArg DeBruijnPattern] -> TCMT IO [(Term, Term)])
 -> TCMT IO (AbsN [(Term, Term)]))
-> ([NamedArg DeBruijnPattern] -> TCMT IO [(Term, Term)])
-> TCMT IO (AbsN [(Term, Term)])
forall a b. (a -> b) -> a -> b
$ \ [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
    [(Term, (Term, Term))]
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)
    [(Term, Term)] -> TCMT IO [(Term, Term)]
forall a. a -> TCMT IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Term, Term)] -> TCMT IO [(Term, Term)])
-> [(Term, Term)] -> TCMT IO [(Term, Term)]
forall a b. (a -> b) -> a -> b
$ ((Term, (Term, Term)) -> [(Term, Term)])
-> [(Term, (Term, Term))] -> [(Term, Term)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(Term
v,(Term
l,Term
r)) -> [(Term
tNeg Term -> Args -> Term
forall t. Apply t => t -> Args -> t
`apply` [Term -> Arg Term
forall e. e -> Arg e
argN Term
v],Term
l),(Term
v,Term
r)]) [(Term, (Term, Term))]
xs
  let
    gamma1ArgNames :: [Arg String]
gamma1ArgNames = Telescope -> [Arg String]
teleArgNames Telescope
gamma1
    deltaArgNames :: [Arg String]
deltaArgNames = Telescope -> [Arg String]
teleArgNames Telescope
delta'
  (AbsN Args
params,AbsN Telescope
xTel,AbsN (AbsN Type)
dT) <- Telescope
-> TCMT IO (AbsN Args, AbsN Telescope, AbsN (AbsN Type))
-> TCMT IO (AbsN Args, AbsN Telescope, AbsN (AbsN Type))
forall b (m :: * -> *) a.
(AddContext b, MonadAddContext m) =>
b -> m a -> m a
forall (m :: * -> *) a.
MonadAddContext m =>
Telescope -> m a -> m a
addContext Telescope
gamma1 (TCMT IO (AbsN Args, AbsN Telescope, AbsN (AbsN Type))
 -> TCMT IO (AbsN Args, AbsN Telescope, AbsN (AbsN Type)))
-> TCMT IO (AbsN Args, AbsN Telescope, AbsN (AbsN Type))
-> TCMT IO (AbsN Args, AbsN Telescope, AbsN (AbsN Type))
forall a b. (a -> b) -> a -> b
$ do
    Just (QName
d, Args
ps, Args
_is) <- Type -> TCMT IO (Maybe (QName, Args, Args))
forall (m :: * -> *).
HasConstInfo m =>
Type -> m (Maybe (QName, Args, Args))
getDatatypeArgs (Type -> TCMT IO (Maybe (QName, Args, Args)))
-> (Dom Type -> Type)
-> Dom Type
-> TCMT IO (Maybe (QName, Args, Args))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dom Type -> Type
forall t e. Dom' t e -> e
unDom (Dom Type -> TCMT IO (Maybe (QName, Args, Args)))
-> TCMT IO (Dom Type) -> TCMT IO (Maybe (QName, Args, Args))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Dom Type -> TCMT IO (Dom Type)
forall a (m :: * -> *). (Reduce a, MonadReduce m) => a -> m a
reduce Dom Type
dType'
    Definition
def <- QName -> TCMT IO Definition
forall (m :: * -> *). HasConstInfo m => QName -> m Definition
getConstInfo QName
d
    let dTy :: Type
dTy = Definition -> Type
defType Definition
def
    let Datatype{dataSort :: Defn -> Sort
dataSort = Sort
s} = Definition -> Defn
theDef Definition
def
    TelV Telescope
tel Type
_ <- Type -> TCMT IO (TelV Type)
forall (m :: * -> *).
(MonadReduce m, MonadAddContext m) =>
Type -> m (TelV Type)
telView Type
dTy
    let params :: AbsN Args
params = [String] -> Args -> AbsN Args
forall a. [String] -> a -> AbsN a
AbsN (Telescope -> [String]
teleNames Telescope
gamma1) Args
ps
        xTel :: AbsN Telescope
xTel = [String] -> Telescope -> AbsN Telescope
forall a. [String] -> a -> AbsN a
AbsN (Telescope -> [String]
teleNames Telescope
gamma1) (Telescope
tel Telescope -> Args -> Telescope
forall t. Apply t => t -> Args -> t
`apply` Args
ps)

    AbsN (AbsN Type)
dT <- [String]
-> NamesT (TCMT IO) (AbsN (AbsN Type))
-> TCMT IO (AbsN (AbsN Type))
forall (m :: * -> *) a. [String] -> NamesT m a -> m a
runNamesT [] (NamesT (TCMT IO) (AbsN (AbsN Type)) -> TCMT IO (AbsN (AbsN Type)))
-> NamesT (TCMT IO) (AbsN (AbsN Type))
-> TCMT IO (AbsN (AbsN Type))
forall a b. (a -> b) -> a -> b
$ do
          NamesT (TCMT IO) (AbsN Sort)
s <- AbsN Sort -> NamesT (TCMT IO) (NamesT (TCMT IO) (AbsN Sort))
forall (m :: * -> *) a.
(MonadFail m, Subst a) =>
a -> NamesT m (NamesT m a)
open (AbsN Sort -> NamesT (TCMT IO) (NamesT (TCMT IO) (AbsN Sort)))
-> AbsN Sort -> NamesT (TCMT IO) (NamesT (TCMT IO) (AbsN Sort))
forall a b. (a -> b) -> a -> b
$ [String] -> Sort -> AbsN Sort
forall a. [String] -> a -> AbsN a
AbsN (Telescope -> [String]
teleNames Telescope
tel) Sort
s
          [Arg String]
-> (ArgVars (TCMT IO) -> NamesT (TCMT IO) (AbsN Type))
-> NamesT (TCMT IO) (AbsN (AbsN Type))
forall (m :: * -> *) a.
MonadFail m =>
[Arg String] -> (ArgVars m -> NamesT m a) -> NamesT m (AbsN a)
bindNArg (Telescope -> [Arg String]
teleArgNames Telescope
gamma1) ((ArgVars (TCMT IO) -> NamesT (TCMT IO) (AbsN Type))
 -> NamesT (TCMT IO) (AbsN (AbsN Type)))
-> (ArgVars (TCMT IO) -> NamesT (TCMT IO) (AbsN Type))
-> NamesT (TCMT IO) (AbsN (AbsN Type))
forall a b. (a -> b) -> a -> b
$ \ ArgVars (TCMT IO)
g1 -> do
          [Arg String]
-> (ArgVars (TCMT IO) -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) (AbsN Type)
forall (m :: * -> *) a.
MonadFail m =>
[Arg String] -> (ArgVars m -> NamesT m a) -> NamesT m (AbsN a)
bindNArg (Telescope -> [Arg String]
teleArgNames (Telescope -> [Arg String]) -> Telescope -> [Arg String]
forall a b. (a -> b) -> a -> b
$ AbsN Telescope -> Telescope
forall a. AbsN a -> a
unAbsN AbsN Telescope
xTel) ((ArgVars (TCMT IO) -> NamesT (TCMT IO) Type)
 -> NamesT (TCMT IO) (AbsN Type))
-> (ArgVars (TCMT IO) -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) (AbsN Type)
forall a b. (a -> b) -> a -> b
$ \ ArgVars (TCMT IO)
x -> do
          Args
params <- AbsN Args -> NamesT (TCMT IO) (AbsN Args)
forall a. a -> NamesT (TCMT IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure AbsN Args
params NamesT (TCMT IO) (AbsN Args)
-> [NamesT (TCMT IO) (SubstArg Args)] -> NamesT (TCMT IO) Args
forall (m :: * -> *) a.
(Monad m, Subst a) =>
NamesT m (AbsN a) -> [NamesT m (SubstArg a)] -> NamesT m a
`applyN` ((Arg Term -> Term)
-> NamesT (TCMT IO) (Arg Term) -> NamesT (TCMT IO) Term
forall a b. (a -> b) -> NamesT (TCMT IO) a -> NamesT (TCMT IO) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Arg Term -> Term
forall e. Arg e -> e
unArg (NamesT (TCMT IO) (Arg Term) -> NamesT (TCMT IO) Term)
-> [NamesT (TCMT IO) (Arg Term)] -> [NamesT (TCMT IO) Term]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [NamesT (TCMT IO) (Arg Term)]
ArgVars (TCMT IO)
g1)
          Args
x      <- [NamesT (TCMT IO) (Arg Term)] -> NamesT (TCMT IO) Args
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence [NamesT (TCMT IO) (Arg Term)]
ArgVars (TCMT IO)
x
          Sort
s <- NamesT (TCMT IO) (AbsN Sort)
s NamesT (TCMT IO) (AbsN Sort)
-> [NamesT (TCMT IO) (SubstArg Sort)] -> NamesT (TCMT IO) Sort
forall (m :: * -> *) a.
(Monad m, Subst a) =>
NamesT m (AbsN a) -> [NamesT m (SubstArg a)] -> NamesT m a
`applyN` ((Arg Term -> NamesT (TCMT IO) (SubstArg Sort))
-> Args -> [NamesT (TCMT IO) (SubstArg Sort)]
forall a b. (a -> b) -> [a] -> [b]
map (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)
-> (Arg Term -> Term) -> Arg Term -> NamesT (TCMT IO) Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Arg Term -> Term
forall e. Arg e -> e
unArg) (Args -> [NamesT (TCMT IO) (SubstArg Sort)])
-> Args -> [NamesT (TCMT IO) (SubstArg Sort)]
forall a b. (a -> b) -> a -> b
$ Args
params Args -> Args -> Args
forall a. [a] -> [a] -> [a]
++ Args
x)
          Type -> NamesT (TCMT IO) Type
forall a. a -> NamesT (TCMT IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Type -> NamesT (TCMT IO) Type) -> Type -> NamesT (TCMT IO) Type
forall a b. (a -> b) -> a -> b
$ Sort -> Term -> Type
forall t a. Sort' t -> a -> Type'' t a
El Sort
s (Term -> Type) -> Term -> Type
forall a b. (a -> b) -> a -> b
$ QName -> [Elim] -> Term
Def QName
d [] Term -> Args -> Term
forall t. Apply t => t -> Args -> t
`apply` (Args
params Args -> Args -> Args
forall a. [a] -> [a] -> [a]
++ Args
x)
    (AbsN Args, AbsN Telescope, AbsN (AbsN Type))
-> TCMT IO (AbsN Args, AbsN Telescope, AbsN (AbsN Type))
forall a. a -> TCMT IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ((AbsN Args, AbsN Telescope, AbsN (AbsN Type))
 -> TCMT IO (AbsN Args, AbsN Telescope, AbsN (AbsN Type)))
-> (AbsN Args, AbsN Telescope, AbsN (AbsN Type))
-> TCMT IO (AbsN Args, AbsN Telescope, AbsN (AbsN Type))
forall a b. (a -> b) -> a -> b
$ (AbsN Args
params, AbsN Telescope
xTel,AbsN (AbsN Type)
dT)

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

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

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

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

    NamesT (TCMT IO) Telescope
xTel <- (Telescope -> NamesT (TCMT IO) (NamesT (TCMT IO) Telescope)
forall (m :: * -> *) a.
(MonadFail m, Subst a) =>
a -> NamesT m (NamesT m a)
open (Telescope -> NamesT (TCMT IO) (NamesT (TCMT IO) Telescope))
-> NamesT (TCMT IO) Telescope
-> NamesT (TCMT IO) (NamesT (TCMT IO) Telescope)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (NamesT (TCMT IO) Telescope
 -> NamesT (TCMT IO) (NamesT (TCMT IO) Telescope))
-> NamesT (TCMT IO) Telescope
-> NamesT (TCMT IO) (NamesT (TCMT IO) Telescope)
forall a b. (a -> b) -> a -> b
$ AbsN Telescope -> NamesT (TCMT IO) (AbsN Telescope)
forall a. a -> NamesT (TCMT IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure AbsN Telescope
xTel NamesT (TCMT IO) (AbsN Telescope)
-> [NamesT (TCMT IO) (SubstArg Telescope)]
-> NamesT (TCMT IO) Telescope
forall (m :: * -> *) a.
(Monad m, Subst a) =>
NamesT m (AbsN a) -> [NamesT m (SubstArg a)] -> NamesT m a
`applyN` [NamesT (TCMT IO) Term]
[NamesT (TCMT IO) (SubstArg Telescope)]
Vars (TCMT IO)
g1
    NamesT (TCMT IO) (Abs [Term])
q4_f <- (Abs [Term] -> NamesT (TCMT IO) (NamesT (TCMT IO) (Abs [Term]))
forall (m :: * -> *) a.
(MonadFail m, Subst a) =>
a -> NamesT m (NamesT m a)
open (Abs [Term] -> NamesT (TCMT IO) (NamesT (TCMT IO) (Abs [Term])))
-> NamesT (TCMT IO) (Abs [Term])
-> NamesT (TCMT IO) (NamesT (TCMT IO) (Abs [Term]))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (NamesT (TCMT IO) (Abs [Term])
 -> NamesT (TCMT IO) (NamesT (TCMT IO) (Abs [Term])))
-> NamesT (TCMT IO) (Abs [Term])
-> NamesT (TCMT IO) (NamesT (TCMT IO) (Abs [Term]))
forall a b. (a -> b) -> a -> b
$ String
-> (Var (TCMT IO) -> NamesT (TCMT IO) [Term])
-> NamesT (TCMT IO) (Abs [Term])
forall (m :: * -> *) a.
MonadFail m =>
String
-> ((forall b. (Subst b, DeBruijn b) => NamesT m b) -> NamesT m a)
-> NamesT m (Abs a)
bind String
"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 -> NamesT (TCMT IO) (Abs [Term]) -> NamesT (TCMT IO) [Term]
forall (m :: * -> *).
Monad m =>
NamesT m (Abs [Term]) -> NamesT m [Term]
lamTel (NamesT (TCMT IO) (Abs [Term]) -> NamesT (TCMT IO) [Term])
-> NamesT (TCMT IO) (Abs [Term]) -> NamesT (TCMT IO) [Term]
forall a b. (a -> b) -> a -> b
$ String
-> (Var (TCMT IO) -> NamesT (TCMT IO) [Term])
-> NamesT (TCMT IO) (Abs [Term])
forall (m :: * -> *) a.
MonadFail m =>
String
-> ((forall b. (Subst b, DeBruijn b) => NamesT m b) -> NamesT m a)
-> NamesT m (Abs a)
bind String
"j" ((Var (TCMT IO) -> NamesT (TCMT IO) [Term])
 -> NamesT (TCMT IO) (Abs [Term]))
-> (Var (TCMT IO) -> NamesT (TCMT IO) [Term])
-> NamesT (TCMT IO) (Abs [Term])
forall a b. (a -> b) -> a -> b
$ \ Var (TCMT IO)
j -> do
      Abs Telescope
ty <- String
-> (Var (TCMT IO) -> NamesT (TCMT IO) Telescope)
-> NamesT (TCMT IO) (Abs Telescope)
forall (m :: * -> *) a.
MonadFail m =>
String
-> ((forall b. (Subst b, DeBruijn b) => NamesT m b) -> NamesT m a)
-> NamesT m (Abs a)
bind String
"i" ((Var (TCMT IO) -> NamesT (TCMT IO) Telescope)
 -> NamesT (TCMT IO) (Abs Telescope))
-> (Var (TCMT IO) -> NamesT (TCMT IO) Telescope)
-> NamesT (TCMT IO) (Abs Telescope)
forall a b. (a -> b) -> a -> b
$ \ Var (TCMT IO)
_ -> NamesT (TCMT IO) Telescope
xTel
      Term
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)
phi (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
forall {m :: * -> *}.
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
NamesT m Term -> NamesT m Term -> NamesT m Term
max (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
neg NamesT (TCMT IO) Term
Var (TCMT IO)
j) (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
neg NamesT (TCMT IO) Term
Var (TCMT IO)
i)
      Args
base <- (Term -> Arg Term) -> [Term] -> Args
forall a b. (a -> b) -> [a] -> [b]
map Term -> Arg Term
forall e. e -> Arg e
defaultArg ([Term] -> Args)
-> NamesT (TCMT IO) [Term] -> NamesT (TCMT IO) Args
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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)
q) NamesT (TCMT IO) Term
Var (TCMT IO)
j
      (Term, Abs [Term])
u  <- (Term -> Abs [Term] -> (Term, Abs [Term]))
-> NamesT (TCMT IO) Term
-> NamesT (TCMT IO) (Abs [Term])
-> NamesT (TCMT IO) (Term, Abs [Term])
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (,) (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)
j NamesT (TCMT IO) Term
Var (TCMT IO)
psi) (NamesT (TCMT IO) (Abs [Term])
 -> NamesT (TCMT IO) (Term, Abs [Term]))
-> NamesT (TCMT IO) (Abs [Term])
-> NamesT (TCMT IO) (Term, Abs [Term])
forall a b. (a -> b) -> a -> b
$ String
-> (Var (TCMT IO) -> NamesT (TCMT IO) [Term])
-> NamesT (TCMT IO) (Abs [Term])
forall (m :: * -> *) a.
MonadFail m =>
String
-> ((forall b. (Subst b, DeBruijn b) => NamesT m b) -> NamesT m a)
-> NamesT m (Abs a)
bind String
"h" ((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)
h -> do
              NamesT (TCMT IO) [Term]
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) [Term]
forall (m :: * -> *).
Monad m =>
NamesT m [Term] -> NamesT m Term -> NamesT m [Term]
appTel ([NamesT (TCMT IO) Term] -> NamesT (TCMT IO) [Term]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence [NamesT (TCMT IO) Term]
Vars (TCMT IO)
p) (NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall {m :: * -> *}.
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
NamesT m Term -> NamesT m Term -> NamesT m Term
min NamesT (TCMT IO) Term
Var (TCMT IO)
j (NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall {m :: * -> *}.
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
NamesT m Term -> NamesT m Term -> NamesT m Term
min NamesT (TCMT IO) Term
Var (TCMT IO)
h NamesT (TCMT IO) Term
Var (TCMT IO)
i))
      Right Args
xs <- TCM (Either (Closure (Abs Type)) Args)
-> NamesT (TCMT IO) (Either (Closure (Abs Type)) Args)
forall (m :: * -> *) a. Monad m => m a -> NamesT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (TCM (Either (Closure (Abs Type)) Args)
 -> NamesT (TCMT IO) (Either (Closure (Abs Type)) Args))
-> TCM (Either (Closure (Abs Type)) Args)
-> NamesT (TCMT IO) (Either (Closure (Abs Type)) Args)
forall a b. (a -> b) -> a -> b
$ ExceptT (Closure (Abs Type)) (TCMT IO) Args
-> TCM (Either (Closure (Abs Type)) Args)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT (Closure (Abs Type)) (TCMT IO) Args
 -> TCM (Either (Closure (Abs Type)) Args))
-> ExceptT (Closure (Abs Type)) (TCMT IO) Args
-> TCM (Either (Closure (Abs Type)) Args)
forall a b. (a -> b) -> a -> b
$ Bool
-> Abs Telescope
-> [(Term, Abs [Term])]
-> Term
-> Args
-> ExceptT (Closure (Abs Type)) (TCMT IO) Args
forall (m :: * -> *).
(PureTCM m, MonadError TCErr m) =>
Bool
-> Abs Telescope
-> [(Term, Abs [Term])]
-> Term
-> Args
-> ExceptT (Closure (Abs Type)) m Args
transpSysTel' Bool
False Abs Telescope
ty [(Term, Abs [Term])
u] Term
face Args
base
      [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
$ (Arg Term -> Term) -> Args -> [Term]
forall a b. (a -> b) -> [a] -> [b]
map Arg Term -> Term
forall e. Arg e -> e
unArg Args
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)
    NamesT (TCMT IO) (Abs Term)
pat_rec <- (Abs Term -> NamesT (TCMT IO) (NamesT (TCMT IO) (Abs Term))
forall (m :: * -> *) a.
(MonadFail m, Subst a) =>
a -> NamesT m (NamesT m a)
open (Abs Term -> NamesT (TCMT IO) (NamesT (TCMT IO) (Abs Term)))
-> NamesT (TCMT IO) (Abs Term)
-> NamesT (TCMT IO) (NamesT (TCMT IO) (Abs Term))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (NamesT (TCMT IO) (Abs Term)
 -> NamesT (TCMT IO) (NamesT (TCMT IO) (Abs Term)))
-> NamesT (TCMT IO) (Abs Term)
-> NamesT (TCMT IO) (NamesT (TCMT IO) (Abs Term))
forall a b. (a -> b) -> a -> b
$ String
-> (Var (TCMT IO) -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) (Abs Term)
forall (m :: * -> *) a.
MonadFail m =>
String
-> ((forall b. (Subst b, DeBruijn b) => NamesT m b) -> NamesT m a)
-> NamesT m (Abs a)
bind String
"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
          [NamesT (TCMT IO) Term]
p_conn <- ((Term -> NamesT (TCMT IO) (NamesT (TCMT IO) Term))
-> [Term] -> NamesT (TCMT IO) [NamesT (TCMT IO) Term]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Term -> NamesT (TCMT IO) (NamesT (TCMT IO) Term)
forall (m :: * -> *) a.
(MonadFail m, Subst a) =>
a -> NamesT m (NamesT m a)
open ([Term] -> NamesT (TCMT IO) [NamesT (TCMT IO) Term])
-> NamesT (TCMT IO) [Term]
-> NamesT (TCMT IO) [NamesT (TCMT IO) Term]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (NamesT (TCMT IO) [Term]
 -> NamesT (TCMT IO) [NamesT (TCMT IO) Term])
-> NamesT (TCMT IO) [Term]
-> NamesT (TCMT IO) [NamesT (TCMT IO) Term]
forall a b. (a -> b) -> a -> b
$ NamesT (TCMT IO) (Abs [Term]) -> NamesT (TCMT IO) [Term]
forall (m :: * -> *).
Monad m =>
NamesT m (Abs [Term]) -> NamesT m [Term]
lamTel (NamesT (TCMT IO) (Abs [Term]) -> NamesT (TCMT IO) [Term])
-> NamesT (TCMT IO) (Abs [Term]) -> NamesT (TCMT IO) [Term]
forall a b. (a -> b) -> a -> b
$ String
-> (Var (TCMT IO) -> NamesT (TCMT IO) [Term])
-> NamesT (TCMT IO) (Abs [Term])
forall (m :: * -> *) a.
MonadFail m =>
String
-> ((forall b. (Subst b, DeBruijn b) => NamesT m b) -> NamesT m a)
-> NamesT m (Abs a)
bind String
"i" ((Var (TCMT IO) -> NamesT (TCMT IO) [Term])
 -> NamesT (TCMT IO) (Abs [Term]))
-> (Var (TCMT IO) -> NamesT (TCMT IO) [Term])
-> NamesT (TCMT IO) (Abs [Term])
forall a b. (a -> b) -> a -> b
$ \ Var (TCMT IO)
j -> [NamesT (TCMT IO) Term] -> NamesT (TCMT IO) [Term]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence [NamesT (TCMT IO) Term]
Vars (TCMT IO)
p NamesT (TCMT IO) [Term]
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) [Term]
forall (m :: * -> *).
Monad m =>
NamesT m [Term] -> NamesT m Term -> NamesT m [Term]
`appTel` NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall {m :: * -> *}.
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
NamesT m Term -> NamesT m Term -> NamesT m Term
max NamesT (TCMT IO) Term
Var (TCMT IO)
i NamesT (TCMT IO) Term
Var (TCMT IO)
j
          [NamesT (TCMT IO) Term]
q4_f' <- ((Term -> NamesT (TCMT IO) (NamesT (TCMT IO) Term))
-> [Term] -> NamesT (TCMT IO) [NamesT (TCMT IO) Term]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Term -> NamesT (TCMT IO) (NamesT (TCMT IO) Term)
forall (m :: * -> *) a.
(MonadFail m, Subst a) =>
a -> NamesT m (NamesT m a)
open ([Term] -> NamesT (TCMT IO) [NamesT (TCMT IO) Term])
-> NamesT (TCMT IO) [Term]
-> NamesT (TCMT IO) [NamesT (TCMT IO) Term]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (NamesT (TCMT IO) [Term]
 -> NamesT (TCMT IO) [NamesT (TCMT IO) Term])
-> NamesT (TCMT IO) [Term]
-> NamesT (TCMT IO) [NamesT (TCMT IO) Term]
forall a b. (a -> b) -> a -> b
$ Abs [Term] -> Term -> [Term]
Abs [Term] -> SubstArg [Term] -> [Term]
forall a. Subst a => Abs a -> SubstArg a -> a
absApp (Abs [Term] -> Term -> [Term])
-> NamesT (TCMT IO) (Abs [Term])
-> NamesT (TCMT IO) (Term -> [Term])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamesT (TCMT IO) (Abs [Term])
q4_f NamesT (TCMT IO) (Term -> [Term])
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) [Term]
forall a b.
NamesT (TCMT IO) (a -> b)
-> NamesT (TCMT IO) a -> NamesT (TCMT IO) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> NamesT (TCMT IO) Term
Var (TCMT IO)
i
          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
-> 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)
phiNamesT (TCMT IO) Term
-> [NamesT (TCMT IO) Term] -> [NamesT (TCMT IO) Term]
forall a. a -> [a] -> [a]
:[NamesT (TCMT IO) Term]
p_conn)
              NamesT (TCMT IO) (AbsN Term)
-> [NamesT (TCMT IO) (SubstArg Term)] -> NamesT (TCMT IO) Term
forall (m :: * -> *) a.
(Monad m, Subst a) =>
NamesT m (AbsN a) -> [NamesT m (SubstArg a)] -> NamesT m a
`applyN` [NamesT (TCMT IO) (AbsN (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
-> 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)
psi (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)
i))NamesT (TCMT IO) Term
-> [NamesT (TCMT IO) Term] -> [NamesT (TCMT IO) Term]
forall a. a -> [a] -> [a]
:[NamesT (TCMT IO) Term]
q4_f') 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]]

    let mkBndry :: NamesT (TCMT IO) (Abs [Term])
-> NamesT
     (TCMT IO) [(NamesT (TCMT IO) Term, NamesT (TCMT IO) Term)]
mkBndry NamesT (TCMT IO) (Abs [Term])
args = do
            [NamesT (TCMT IO) Term]
args1 <- ((Term -> NamesT (TCMT IO) (NamesT (TCMT IO) Term))
-> [Term] -> NamesT (TCMT IO) [NamesT (TCMT IO) Term]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Term -> NamesT (TCMT IO) (NamesT (TCMT IO) Term)
forall (m :: * -> *) a.
(MonadFail m, Subst a) =>
a -> NamesT m (NamesT m a)
open ([Term] -> NamesT (TCMT IO) [NamesT (TCMT IO) Term])
-> NamesT (TCMT IO) [Term]
-> NamesT (TCMT IO) [NamesT (TCMT IO) Term]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (NamesT (TCMT IO) [Term]
 -> NamesT (TCMT IO) [NamesT (TCMT IO) Term])
-> NamesT (TCMT IO) [Term]
-> NamesT (TCMT IO) [NamesT (TCMT IO) Term]
forall a b. (a -> b) -> a -> b
$ (Abs [Term] -> Term -> [Term]
Abs [Term] -> SubstArg [Term] -> [Term]
forall a. Subst a => Abs a -> SubstArg a -> a
absApp (Abs [Term] -> Term -> [Term])
-> NamesT (TCMT IO) (Abs [Term])
-> NamesT (TCMT IO) (Term -> [Term])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamesT (TCMT IO) (Abs [Term])
args NamesT (TCMT IO) (Term -> [Term])
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) [Term]
forall a b.
NamesT (TCMT IO) (a -> b)
-> NamesT (TCMT IO) a -> NamesT (TCMT IO) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Term -> NamesT (TCMT IO) Term
forall a. a -> NamesT (TCMT IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
io)
            -- faces ought to be constant on "j"
            [Term]
faces <- AbsN [Term] -> NamesT (TCMT IO) (AbsN [Term])
forall a. a -> NamesT (TCMT IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (([(Term, Term)] -> [Term]) -> AbsN [(Term, Term)] -> AbsN [Term]
forall a b. (a -> b) -> AbsN a -> AbsN b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((Term, Term) -> Term) -> [(Term, Term)] -> [Term]
forall a b. (a -> b) -> [a] -> [b]
map (Term, Term) -> Term
forall a b. (a, b) -> a
fst) AbsN [(Term, Term)]
old_sides) 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])]
args1
            [Term]
us <- [AbsN Term]
-> (AbsN Term -> NamesT (TCMT IO) Term) -> NamesT (TCMT IO) [Term]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (([(Term, Term)] -> [Term]) -> AbsN [(Term, Term)] -> [AbsN 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) -> AbsN a -> m (AbsN b)
mapM (((Term, Term) -> Term) -> [(Term, Term)] -> [Term]
forall a b. (a -> b) -> [a] -> [b]
map (Term, Term) -> Term
forall a b. (a, b) -> b
snd) AbsN [(Term, Term)]
old_sides) ((AbsN Term -> NamesT (TCMT IO) Term) -> NamesT (TCMT IO) [Term])
-> (AbsN Term -> NamesT (TCMT IO) Term) -> NamesT (TCMT IO) [Term]
forall a b. (a -> b) -> a -> b
$ \ AbsN Term
u -> do
                  String
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
lam String
"j" ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
 -> NamesT (TCMT IO) Term)
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall a b. (a -> b) -> a -> b
$ \ NamesT (TCMT IO) Term
j -> String
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
ilam String
"o" ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
 -> NamesT (TCMT IO) Term)
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall a b. (a -> b) -> a -> b
$ \ NamesT (TCMT IO) Term
_ -> do
                    [NamesT (TCMT IO) Term]
args <- ((Term -> NamesT (TCMT IO) (NamesT (TCMT IO) Term))
-> [Term] -> NamesT (TCMT IO) [NamesT (TCMT IO) Term]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Term -> NamesT (TCMT IO) (NamesT (TCMT IO) Term)
forall (m :: * -> *) a.
(MonadFail m, Subst a) =>
a -> NamesT m (NamesT m a)
open ([Term] -> NamesT (TCMT IO) [NamesT (TCMT IO) Term])
-> NamesT (TCMT IO) [Term]
-> NamesT (TCMT IO) [NamesT (TCMT IO) Term]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (NamesT (TCMT IO) [Term]
 -> NamesT (TCMT IO) [NamesT (TCMT IO) Term])
-> NamesT (TCMT IO) [Term]
-> NamesT (TCMT IO) [NamesT (TCMT IO) Term]
forall a b. (a -> b) -> a -> b
$ (Abs [Term] -> Term -> [Term]
Abs [Term] -> SubstArg [Term] -> [Term]
forall a. Subst a => Abs a -> SubstArg a -> a
absApp (Abs [Term] -> Term -> [Term])
-> NamesT (TCMT IO) (Abs [Term])
-> NamesT (TCMT IO) (Term -> [Term])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamesT (TCMT IO) (Abs [Term])
args NamesT (TCMT IO) (Term -> [Term])
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) [Term]
forall a b.
NamesT (TCMT IO) (a -> b)
-> NamesT (TCMT IO) a -> NamesT (TCMT IO) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> NamesT (TCMT IO) Term
j)
                    AbsN Term -> NamesT (TCMT IO) (AbsN Term)
forall a. a -> NamesT (TCMT IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure AbsN Term
u 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)]
args
            [(Term, Term)]
-> ((Term, Term)
    -> NamesT (TCMT IO) (NamesT (TCMT IO) Term, NamesT (TCMT IO) Term))
-> NamesT
     (TCMT IO) [(NamesT (TCMT IO) Term, NamesT (TCMT IO) Term)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM ([Term] -> [Term] -> [(Term, Term)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Term]
faces [Term]
us) (((Term, Term)
  -> NamesT (TCMT IO) (NamesT (TCMT IO) Term, NamesT (TCMT IO) Term))
 -> NamesT
      (TCMT IO) [(NamesT (TCMT IO) Term, NamesT (TCMT IO) Term)])
-> ((Term, Term)
    -> NamesT (TCMT IO) (NamesT (TCMT IO) Term, NamesT (TCMT IO) Term))
-> NamesT
     (TCMT IO) [(NamesT (TCMT IO) Term, NamesT (TCMT IO) Term)]
forall a b. (a -> b) -> a -> b
$ \ (Term
phi,Term
u) -> (NamesT (TCMT IO) Term
 -> NamesT (TCMT IO) Term
 -> (NamesT (TCMT IO) Term, NamesT (TCMT IO) Term))
-> NamesT (TCMT IO) (NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) (NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) (NamesT (TCMT IO) Term, NamesT (TCMT IO) Term)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (,) (Term -> NamesT (TCMT IO) (NamesT (TCMT IO) Term)
forall (m :: * -> *) a.
(MonadFail m, Subst a) =>
a -> NamesT m (NamesT m a)
open Term
phi) (Term -> NamesT (TCMT IO) (NamesT (TCMT IO) Term)
forall (m :: * -> *) a.
(MonadFail m, Subst a) =>
a -> NamesT m (NamesT m a)
open Term
u)
    let mkComp :: NamesT (TCMT IO) (AbsN Term) -> NamesT (TCMT IO) (Abs Term)
mkComp NamesT (TCMT IO) (AbsN Term)
pr = String
-> (Var (TCMT IO) -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) (Abs Term)
forall (m :: * -> *) a.
MonadFail m =>
String
-> ((forall b. (Subst b, DeBruijn b) => NamesT m b) -> NamesT m a)
-> NamesT m (Abs a)
bind String
"i" ((Var (TCMT IO) -> NamesT (TCMT IO) Term)
 -> NamesT (TCMT IO) (Abs Term))
-> (Var (TCMT IO) -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) (Abs Term)
forall a b. (a -> b) -> a -> b
$ \ Var (TCMT IO)
i -> do
          NamesT (TCMT IO) (Abs [Term])
d_f <- (Abs [Term] -> NamesT (TCMT IO) (NamesT (TCMT IO) (Abs [Term]))
forall (m :: * -> *) a.
(MonadFail m, Subst a) =>
a -> NamesT m (NamesT m a)
open (Abs [Term] -> NamesT (TCMT IO) (NamesT (TCMT IO) (Abs [Term])))
-> NamesT (TCMT IO) (Abs [Term])
-> NamesT (TCMT IO) (NamesT (TCMT IO) (Abs [Term]))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (NamesT (TCMT IO) (Abs [Term])
 -> NamesT (TCMT IO) (NamesT (TCMT IO) (Abs [Term])))
-> NamesT (TCMT IO) (Abs [Term])
-> NamesT (TCMT IO) (NamesT (TCMT IO) (Abs [Term]))
forall a b. (a -> b) -> a -> b
$ String
-> (Var (TCMT IO) -> NamesT (TCMT IO) [Term])
-> NamesT (TCMT IO) (Abs [Term])
forall (m :: * -> *) a.
MonadFail m =>
String
-> ((forall b. (Subst b, DeBruijn b) => NamesT m b) -> NamesT m a)
-> NamesT m (Abs a)
bind String
"j" ((Var (TCMT IO) -> NamesT (TCMT IO) [Term])
 -> NamesT (TCMT IO) (Abs [Term]))
-> (Var (TCMT IO) -> NamesT (TCMT IO) [Term])
-> NamesT (TCMT IO) (Abs [Term])
forall a b. (a -> b) -> a -> b
$ \ Var (TCMT IO)
j -> do
            Abs Telescope
tel <- String
-> (Var (TCMT IO) -> NamesT (TCMT IO) Telescope)
-> NamesT (TCMT IO) (Abs Telescope)
forall (m :: * -> *) a.
MonadFail m =>
String
-> ((forall b. (Subst b, DeBruijn b) => NamesT m b) -> NamesT m a)
-> NamesT m (Abs a)
bind String
"j" ((Var (TCMT IO) -> NamesT (TCMT IO) Telescope)
 -> NamesT (TCMT IO) (Abs Telescope))
-> (Var (TCMT IO) -> NamesT (TCMT IO) Telescope)
-> NamesT (TCMT IO) (Abs Telescope)
forall a b. (a -> b) -> a -> b
$ \ Var (TCMT IO)
j -> NamesT (TCMT IO) (AbsN Telescope)
delta NamesT (TCMT IO) (AbsN Telescope)
-> [NamesT (TCMT IO) (SubstArg Telescope)]
-> NamesT (TCMT IO) Telescope
forall (m :: * -> *) a.
(Monad m, Subst a) =>
NamesT m (AbsN a) -> [NamesT m (SubstArg a)] -> NamesT m a
`applyN` ([NamesT (TCMT IO) Term]
Vars (TCMT IO)
g1 [NamesT (TCMT IO) Term]
-> [NamesT (TCMT IO) Term] -> [NamesT (TCMT IO) Term]
forall a. [a] -> [a] -> [a]
++ [NamesT (TCMT IO) (AbsN Term)
pr NamesT (TCMT IO) (AbsN Term)
-> [NamesT (TCMT IO) (SubstArg Term)] -> NamesT (TCMT IO) Term
forall (m :: * -> *) a.
(Monad m, Subst a) =>
NamesT m (AbsN a) -> [NamesT m (SubstArg a)] -> NamesT m a
`applyN` [NamesT (TCMT IO) Term
NamesT (TCMT IO) (SubstArg Term)
Var (TCMT IO)
i,NamesT (TCMT IO) Term
NamesT (TCMT IO) (SubstArg Term)
Var (TCMT IO)
j]])
            Term
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
min NamesT (TCMT IO) Term
Var (TCMT IO)
phi NamesT (TCMT IO) Term
Var (TCMT IO)
psi NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall {m :: * -> *}.
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
NamesT m Term -> NamesT m Term -> NamesT m Term
`max` (NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> 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)
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 NamesT (TCMT IO) Term
Var (TCMT IO)
psi))
            Term
j <- NamesT (TCMT IO) Term
Var (TCMT IO)
j
            Args
d <- (Term -> Arg Term) -> [Term] -> Args
forall a b. (a -> b) -> [a] -> [b]
map Term -> Arg Term
forall e. e -> Arg e
defaultArg ([Term] -> Args)
-> NamesT (TCMT IO) [Term] -> NamesT (TCMT IO) Args
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [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)
d
            TCM [Term] -> NamesT (TCMT IO) [Term]
forall (m :: * -> *) a. Monad m => m a -> NamesT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (TCM [Term] -> NamesT (TCMT IO) [Term])
-> TCM [Term] -> NamesT (TCMT IO) [Term]
forall a b. (a -> b) -> a -> b
$ QName -> Abs Telescope -> Term -> Args -> Term -> TCM [Term]
covFillTele QName
f Abs Telescope
tel Term
face Args
d Term
j
          let args :: NamesT (TCMT IO) (Abs [Term])
args = String
-> (Var (TCMT IO) -> NamesT (TCMT IO) [Term])
-> NamesT (TCMT IO) (Abs [Term])
forall (m :: * -> *) a.
MonadFail m =>
String
-> ((forall b. (Subst b, DeBruijn b) => NamesT m b) -> NamesT m a)
-> NamesT m (Abs a)
bind String
"j" ((Var (TCMT IO) -> NamesT (TCMT IO) [Term])
 -> NamesT (TCMT IO) (Abs [Term]))
-> (Var (TCMT IO) -> NamesT (TCMT IO) [Term])
-> NamesT (TCMT IO) (Abs [Term])
forall a b. (a -> b) -> a -> b
$ \ Var (TCMT IO)
j -> do
                [Term]
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
                Term
x <- 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) Term
neg NamesT (TCMT IO) Term
Var (TCMT IO)
j]
                [Term]
ys <- 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])
d_f NamesT (TCMT IO) (Term -> [Term])
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) [Term]
forall a b.
NamesT (TCMT IO) (a -> b)
-> NamesT (TCMT IO) a -> NamesT (TCMT IO) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
neg NamesT (TCMT IO) Term
Var (TCMT IO)
j
                [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
$ [Term]
g1 [Term] -> [Term] -> [Term]
forall a. [a] -> [a] -> [a]
++ Term
xTerm -> [Term] -> [Term]
forall a. a -> [a] -> [a]
:[Term]
ys
          NamesT (TCMT IO) (Abs Type)
ty <- (Abs Type -> NamesT (TCMT IO) (NamesT (TCMT IO) (Abs Type))
forall (m :: * -> *) a.
(MonadFail m, Subst a) =>
a -> NamesT m (NamesT m a)
open (Abs Type -> NamesT (TCMT IO) (NamesT (TCMT IO) (Abs Type)))
-> NamesT (TCMT IO) (Abs Type)
-> NamesT (TCMT IO) (NamesT (TCMT IO) (Abs Type))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (NamesT (TCMT IO) (Abs Type)
 -> NamesT (TCMT IO) (NamesT (TCMT IO) (Abs Type)))
-> NamesT (TCMT IO) (Abs Type)
-> NamesT (TCMT IO) (NamesT (TCMT IO) (Abs Type))
forall a b. (a -> b) -> a -> b
$ String
-> (Var (TCMT IO) -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) (Abs Type)
forall (m :: * -> *) a.
MonadFail m =>
String
-> ((forall b. (Subst b, DeBruijn b) => NamesT m b) -> NamesT m a)
-> NamesT m (Abs a)
bind String
"j" ((Var (TCMT IO) -> NamesT (TCMT IO) Type)
 -> NamesT (TCMT IO) (Abs Type))
-> (Var (TCMT IO) -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) (Abs Type)
forall a b. (a -> b) -> a -> b
$ \ Var (TCMT IO)
j -> do
               [NamesT (TCMT IO) Term]
args <- ((Term -> NamesT (TCMT IO) (NamesT (TCMT IO) Term))
-> [Term] -> NamesT (TCMT IO) [NamesT (TCMT IO) Term]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Term -> NamesT (TCMT IO) (NamesT (TCMT IO) Term)
forall (m :: * -> *) a.
(MonadFail m, Subst a) =>
a -> NamesT m (NamesT m a)
open ([Term] -> NamesT (TCMT IO) [NamesT (TCMT IO) Term])
-> NamesT (TCMT IO) [Term]
-> NamesT (TCMT IO) [NamesT (TCMT IO) Term]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (NamesT (TCMT IO) [Term]
 -> NamesT (TCMT IO) [NamesT (TCMT IO) Term])
-> NamesT (TCMT IO) [Term]
-> NamesT (TCMT IO) [NamesT (TCMT IO) Term]
forall a b. (a -> b) -> a -> b
$ Abs [Term] -> Term -> [Term]
Abs [Term] -> SubstArg [Term] -> [Term]
forall a. Subst a => Abs a -> SubstArg a -> a
absApp (Abs [Term] -> Term -> [Term])
-> NamesT (TCMT IO) (Abs [Term])
-> NamesT (TCMT IO) (Term -> [Term])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamesT (TCMT IO) (Abs [Term])
args NamesT (TCMT IO) (Term -> [Term])
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) [Term]
forall a b.
NamesT (TCMT IO) (a -> b)
-> NamesT (TCMT IO) a -> NamesT (TCMT IO) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> NamesT (TCMT IO) Term
Var (TCMT IO)
j
               (Dom Type -> Type)
-> NamesT (TCMT IO) (Dom Type) -> NamesT (TCMT IO) Type
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 Dom Type -> Type
forall t e. Dom' t e -> e
unDom (NamesT (TCMT IO) (Dom Type) -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) (Dom Type) -> NamesT (TCMT IO) Type
forall a b. (a -> b) -> a -> b
$ 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]
[NamesT (TCMT IO) (SubstArg (Dom Type))]
args
          let face :: NamesT (TCMT IO) Term
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)
          NamesT (TCMT IO) Term
base <- (Term -> NamesT (TCMT IO) (NamesT (TCMT IO) Term)
forall (m :: * -> *) a.
(MonadFail m, Subst a) =>
a -> NamesT m (NamesT m a)
open (Term -> NamesT (TCMT IO) (NamesT (TCMT IO) Term))
-> NamesT (TCMT IO) Term
-> NamesT (TCMT IO) (NamesT (TCMT IO) Term)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (NamesT (TCMT IO) Term -> NamesT (TCMT IO) (NamesT (TCMT IO) Term))
-> NamesT (TCMT IO) Term
-> NamesT (TCMT IO) (NamesT (TCMT IO) Term)
forall a b. (a -> b) -> a -> b
$ do
            [NamesT (TCMT IO) Term]
args' <- ((Term -> NamesT (TCMT IO) (NamesT (TCMT IO) Term))
-> [Term] -> NamesT (TCMT IO) [NamesT (TCMT IO) Term]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Term -> NamesT (TCMT IO) (NamesT (TCMT IO) Term)
forall (m :: * -> *) a.
(MonadFail m, Subst a) =>
a -> NamesT m (NamesT m a)
open ([Term] -> NamesT (TCMT IO) [NamesT (TCMT IO) Term])
-> NamesT (TCMT IO) [Term]
-> NamesT (TCMT IO) [NamesT (TCMT IO) Term]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (NamesT (TCMT IO) [Term]
 -> NamesT (TCMT IO) [NamesT (TCMT IO) Term])
-> NamesT (TCMT IO) [Term]
-> NamesT (TCMT IO) [NamesT (TCMT IO) Term]
forall a b. (a -> b) -> a -> b
$ Abs [Term] -> Term -> [Term]
Abs [Term] -> SubstArg [Term] -> [Term]
forall a. Subst a => Abs a -> SubstArg a -> a
absApp (Abs [Term] -> Term -> [Term])
-> NamesT (TCMT IO) (Abs [Term])
-> NamesT (TCMT IO) (Term -> [Term])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamesT (TCMT IO) (Abs [Term])
args NamesT (TCMT IO) (Term -> [Term])
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) [Term]
forall a b.
NamesT (TCMT IO) (a -> b)
-> NamesT (TCMT IO) a -> NamesT (TCMT IO) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Term -> NamesT (TCMT IO) Term
forall a. a -> NamesT (TCMT IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
iz
            ([Elim] -> Term)
-> NamesT (TCMT IO) [Elim] -> 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 (QName -> [Elim] -> Term
Def QName
f) (NamesT (TCMT IO) [Elim] -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) [Elim] -> NamesT (TCMT IO) Term
forall a b. (a -> b) -> a -> b
$ (([NamedArg DeBruijnPattern] -> [Elim])
-> AbsN [NamedArg DeBruijnPattern] -> AbsN [Elim]
forall a b. (a -> b) -> AbsN a -> AbsN b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [NamedArg DeBruijnPattern] -> [Elim]
patternsToElims (AbsN [NamedArg DeBruijnPattern] -> AbsN [Elim])
-> NamesT (TCMT IO) (AbsN [NamedArg DeBruijnPattern])
-> NamesT (TCMT IO) (AbsN [Elim])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamesT (TCMT IO) (AbsN [NamedArg DeBruijnPattern])
old_ps) NamesT (TCMT IO) (AbsN [Elim])
-> [NamesT (TCMT IO) (SubstArg [Elim])] -> NamesT (TCMT IO) [Elim]
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 [Elim])]
args'
          [(NamesT (TCMT IO) Term, NamesT (TCMT IO) Term)]
sys <- NamesT (TCMT IO) (Abs [Term])
-> NamesT
     (TCMT IO) [(NamesT (TCMT IO) Term, NamesT (TCMT IO) Term)]
mkBndry NamesT (TCMT IO) (Abs [Term])
args
          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
face NamesT (TCMT IO) Term
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.
    NamesT (TCMT IO) Term
syspsi <- (Term -> NamesT (TCMT IO) (NamesT (TCMT IO) Term)
forall (m :: * -> *) a.
(MonadFail m, Subst a) =>
a -> NamesT m (NamesT m a)
open (Term -> NamesT (TCMT IO) (NamesT (TCMT IO) Term))
-> NamesT (TCMT IO) Term
-> NamesT (TCMT IO) (NamesT (TCMT IO) Term)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (NamesT (TCMT IO) Term -> NamesT (TCMT IO) (NamesT (TCMT IO) Term))
-> NamesT (TCMT IO) Term
-> NamesT (TCMT IO) (NamesT (TCMT IO) Term)
forall a b. (a -> b) -> a -> b
$ String
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
lam String
"i" ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
 -> NamesT (TCMT IO) Term)
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall a b. (a -> b) -> a -> b
$ \ NamesT (TCMT IO) Term
i -> String
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
ilam String
"o" ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
 -> NamesT (TCMT IO) Term)
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall a b. (a -> b) -> a -> b
$ \ NamesT (TCMT IO) Term
_ -> do
      Abs Term
c <- NamesT (TCMT IO) (AbsN Term) -> NamesT (TCMT IO) (Abs Term)
mkComp (NamesT (TCMT IO) (AbsN Term) -> NamesT (TCMT IO) (Abs Term))
-> NamesT (TCMT IO) (AbsN Term) -> NamesT (TCMT IO) (Abs Term)
forall a b. (a -> b) -> a -> b
$ [String]
-> (Vars (TCMT IO) -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) (AbsN Term)
forall (m :: * -> *) a.
MonadFail m =>
[String] -> (Vars m -> NamesT m a) -> NamesT m (AbsN a)
bindN [String
"i",String
"j"] ((Vars (TCMT IO) -> NamesT (TCMT IO) Term)
 -> NamesT (TCMT IO) (AbsN Term))
-> (Vars (TCMT IO) -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) (AbsN Term)
forall a b. (a -> b) -> a -> b
$ \ [NamesT (TCMT IO) Term
i,NamesT (TCMT IO) Term
j] -> do
        Abs String
n (Type
data_ty,[Term]
lines) <- String
-> (Var (TCMT IO) -> NamesT (TCMT IO) (Type, [Term]))
-> NamesT (TCMT IO) (Abs (Type, [Term]))
forall (m :: * -> *) a.
MonadFail m =>
String
-> ((forall b. (Subst b, DeBruijn b) => NamesT m b) -> NamesT m a)
-> NamesT m (Abs a)
bind String
"k" ((Var (TCMT IO) -> NamesT (TCMT IO) (Type, [Term]))
 -> NamesT (TCMT IO) (Abs (Type, [Term])))
-> (Var (TCMT IO) -> NamesT (TCMT IO) (Type, [Term]))
-> NamesT (TCMT IO) (Abs (Type, [Term]))
forall a b. (a -> b) -> a -> b
$ \ Var (TCMT IO)
k -> do
          let phi_k :: NamesT (TCMT IO) Term
phi_k = NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall {m :: * -> *}.
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
NamesT m Term -> NamesT m Term -> NamesT m Term
max NamesT (TCMT IO) Term
Var (TCMT IO)
phi (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
neg NamesT (TCMT IO) Term
Var (TCMT IO)
k)
          let p_k :: [NamesT (TCMT IO) Term]
p_k = [NamesT (TCMT IO) Term]
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> [NamesT (TCMT IO) Term]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
for [NamesT (TCMT IO) Term]
Vars (TCMT IO)
p ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
 -> [NamesT (TCMT IO) Term])
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> [NamesT (TCMT IO) Term]
forall a b. (a -> b) -> a -> b
$ \ NamesT (TCMT IO) Term
p -> String
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
lam String
"h" ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
 -> NamesT (TCMT IO) Term)
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall a b. (a -> b) -> a -> b
$ \ NamesT (TCMT IO) Term
h -> NamesT (TCMT IO) Term
p NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> (NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall {m :: * -> *}.
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
NamesT m Term -> NamesT m Term -> NamesT m Term
min NamesT (TCMT IO) Term
Var (TCMT IO)
k NamesT (TCMT IO) Term
h)
          Type
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) (SubstArg Type))
-> [NamesT (TCMT IO) (SubstArg Type)]
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) (SubstArg Type))
 -> [NamesT (TCMT IO) (SubstArg Type)])
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) (SubstArg Type))
-> [NamesT (TCMT IO) (SubstArg Type)]
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
<@> NamesT (TCMT IO) Term
Var (TCMT IO)
k)
          Term
line1 <- 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
phi_kNamesT (TCMT IO) Term
-> [NamesT (TCMT IO) Term] -> [NamesT (TCMT IO) Term]
forall a. a -> [a] -> [a]
:[NamesT (TCMT IO) Term]
p_k) 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]

          Term
line2 <- 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
-> 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
phi_k NamesT (TCMT IO) Term
j      NamesT (TCMT IO) Term
-> [NamesT (TCMT IO) Term] -> [NamesT (TCMT IO) Term]
forall a. a -> [a] -> [a]
: ([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]
p_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
p -> String
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
lam String
"h" ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
 -> NamesT (TCMT IO) Term)
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall a b. (a -> b) -> a -> b
$ \ NamesT (TCMT IO) Term
h -> NamesT (TCMT IO) Term
p NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> (NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall {m :: * -> *}.
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
NamesT m Term -> NamesT m Term -> NamesT m Term
max NamesT (TCMT IO) Term
h NamesT (TCMT IO) Term
j)))
                       NamesT (TCMT IO) (AbsN Term)
-> [NamesT (TCMT IO) (SubstArg Term)] -> NamesT (TCMT IO) Term
forall (m :: * -> *) a.
(Monad m, Subst a) =>
NamesT m (AbsN a) -> [NamesT m (SubstArg a)] -> NamesT m a
`applyN`
                  [NamesT (TCMT IO) (AbsN (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
-> 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
phi_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 a. a -> [a] -> [a]
: ([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]
p_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
p -> String
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
lam String
"h" ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
 -> NamesT (TCMT IO) Term)
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall a b. (a -> b) -> a -> b
$ \ NamesT (TCMT IO) Term
h -> NamesT (TCMT IO) Term
p NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> (NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall {m :: * -> *}.
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
NamesT m Term -> NamesT m Term -> NamesT m Term
min NamesT (TCMT IO) Term
h NamesT (TCMT IO) Term
j)))
                       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]]
          (Type, [Term]) -> NamesT (TCMT IO) (Type, [Term])
forall a. a -> NamesT (TCMT IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Type
data_ty,[Term
line1,Term
line2])
        NamesT (TCMT IO) (Abs Type)
data_ty <- Abs Type -> NamesT (TCMT IO) (NamesT (TCMT IO) (Abs Type))
forall (m :: * -> *) a.
(MonadFail 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
$ String -> Type -> Abs Type
forall a. String -> a -> Abs a
Abs String
n Type
data_ty
        [NamesT (TCMT IO) (Abs Term)
line1,NamesT (TCMT IO) (Abs Term)
line2] <- (Term -> NamesT (TCMT IO) (NamesT (TCMT IO) (Abs Term)))
-> [Term] -> NamesT (TCMT IO) [NamesT (TCMT IO) (Abs 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 (Abs Term -> NamesT (TCMT IO) (NamesT (TCMT IO) (Abs Term))
forall (m :: * -> *) a.
(MonadFail m, Subst a) =>
a -> NamesT m (NamesT m a)
open (Abs Term -> NamesT (TCMT IO) (NamesT (TCMT IO) (Abs Term)))
-> (Term -> Abs Term)
-> Term
-> NamesT (TCMT IO) (NamesT (TCMT IO) (Abs Term))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Term -> Abs Term
forall a. String -> a -> Abs a
Abs String
n) [Term]
lines
        let sys :: [(NamesT (TCMT IO) Term, NamesT (TCMT IO) Term)]
sys = [(NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
neg NamesT (TCMT IO) Term
i, String
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
lam String
"k" ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
 -> NamesT (TCMT IO) Term)
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall a b. (a -> b) -> a -> b
$ \ NamesT (TCMT IO) Term
k -> String
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
ilam String
"o" ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
 -> NamesT (TCMT IO) Term)
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall a b. (a -> b) -> a -> b
$ \ NamesT (TCMT IO) Term
_ -> Abs Term -> Term -> Term
Abs Term -> SubstArg Term -> Term
forall a. Subst a => Abs a -> SubstArg a -> a
absApp (Abs Term -> Term -> Term)
-> NamesT (TCMT IO) (Abs Term) -> NamesT (TCMT IO) (Term -> Term)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamesT (TCMT IO) (Abs Term)
line2 NamesT (TCMT IO) (Term -> Term)
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall a b.
NamesT (TCMT IO) (a -> b)
-> NamesT (TCMT IO) a -> NamesT (TCMT IO) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> NamesT (TCMT IO) Term
k)
                  ,(NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
neg NamesT (TCMT IO) Term
j NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall {m :: * -> *}.
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
NamesT m Term -> NamesT m Term -> NamesT m Term
`max` NamesT (TCMT IO) Term
j NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall {m :: * -> *}.
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
NamesT m Term -> NamesT m Term -> NamesT m Term
`max` NamesT (TCMT IO) Term
i NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall {m :: * -> *}.
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
NamesT m Term -> NamesT m Term -> NamesT m Term
`max` NamesT (TCMT IO) Term
Var (TCMT IO)
phi, String
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
lam String
"k" ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
 -> NamesT (TCMT IO) Term)
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall a b. (a -> b) -> a -> b
$ \ NamesT (TCMT IO) Term
k -> String
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
ilam String
"o" ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
 -> NamesT (TCMT IO) Term)
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall a b. (a -> b) -> a -> b
$ \ NamesT (TCMT IO) Term
_ -> Abs Term -> Term -> Term
Abs Term -> SubstArg Term -> Term
forall a. Subst a => Abs a -> SubstArg a -> a
absApp (Abs Term -> Term -> Term)
-> NamesT (TCMT IO) (Abs Term) -> NamesT (TCMT IO) (Term -> Term)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamesT (TCMT IO) (Abs Term)
line1 NamesT (TCMT IO) (Term -> Term)
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall a b.
NamesT (TCMT IO) (a -> b)
-> NamesT (TCMT IO) a -> NamesT (TCMT IO) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> NamesT (TCMT IO) Term
k)
                  ]
        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)
data_ty [(NamesT (TCMT IO) Term, NamesT (TCMT IO) Term)]
sys (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
Var (TCMT IO)
x0
      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
<$> Abs Term -> NamesT (TCMT IO) (Abs Term)
forall a. a -> NamesT (TCMT IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Abs Term
c 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
    NamesT (TCMT IO) Term
sysphi <- (Term -> NamesT (TCMT IO) (NamesT (TCMT IO) Term)
forall (m :: * -> *) a.
(MonadFail m, Subst a) =>
a -> NamesT m (NamesT m a)
open (Term -> NamesT (TCMT IO) (NamesT (TCMT IO) Term))
-> NamesT (TCMT IO) Term
-> NamesT (TCMT IO) (NamesT (TCMT IO) Term)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (NamesT (TCMT IO) Term -> NamesT (TCMT IO) (NamesT (TCMT IO) Term))
-> NamesT (TCMT IO) Term
-> NamesT (TCMT IO) (NamesT (TCMT IO) Term)
forall a b. (a -> b) -> a -> b
$ String
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
lam String
"i" ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
 -> NamesT (TCMT IO) Term)
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall a b. (a -> b) -> a -> b
$ \ NamesT (TCMT IO) Term
i -> String
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
ilam String
"o" ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
 -> NamesT (TCMT IO) Term)
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall a b. (a -> b) -> a -> b
$ \ NamesT (TCMT IO) Term
o -> do
      Abs Term
c <- NamesT (TCMT IO) (AbsN Term) -> NamesT (TCMT IO) (Abs Term)
mkComp (NamesT (TCMT IO) (AbsN Term) -> NamesT (TCMT IO) (Abs Term))
-> NamesT (TCMT IO) (AbsN Term) -> NamesT (TCMT IO) (Abs Term)
forall a b. (a -> b) -> a -> b
$ [String]
-> (Vars (TCMT IO) -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) (AbsN Term)
forall (m :: * -> *) a.
MonadFail m =>
[String] -> (Vars m -> NamesT m a) -> NamesT m (AbsN a)
bindN [String
"i",String
"j"] ((Vars (TCMT IO) -> NamesT (TCMT IO) Term)
 -> NamesT (TCMT IO) (AbsN Term))
-> (Vars (TCMT IO) -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) (AbsN Term)
forall a b. (a -> b) -> a -> b
$ \ Vars (TCMT IO)
_ij -> do
        NamesT (TCMT IO) (AbsN (AbsN (AbsN Term)))
trX NamesT (TCMT IO) (AbsN (AbsN (AbsN Term)))
-> [NamesT (TCMT IO) (SubstArg (AbsN (AbsN Term)))]
-> NamesT (TCMT IO) (AbsN (AbsN Term))
forall (m :: * -> *) a.
(Monad m, Subst a) =>
NamesT m (AbsN a) -> [NamesT m (SubstArg a)] -> NamesT m a
`applyN` [NamesT (TCMT IO) Term]
[NamesT (TCMT IO) (SubstArg (AbsN (AbsN Term)))]
Vars (TCMT IO)
g1 NamesT (TCMT IO) (AbsN (AbsN Term))
-> [NamesT (TCMT IO) (SubstArg (AbsN Term))]
-> NamesT (TCMT IO) (AbsN Term)
forall (m :: * -> *) a.
(Monad m, Subst a) =>
NamesT m (AbsN a) -> [NamesT m (SubstArg a)] -> NamesT m a
`applyN` (NamesT (TCMT IO) Term
Var (TCMT IO)
psiNamesT (TCMT IO) Term
-> [NamesT (TCMT IO) Term] -> [NamesT (TCMT IO) Term]
forall a. a -> [a] -> [a]
:[NamesT (TCMT IO) Term]
Vars (TCMT IO)
q) NamesT (TCMT IO) (AbsN Term)
-> [NamesT (TCMT IO) (SubstArg Term)] -> NamesT (TCMT IO) Term
forall (m :: * -> *) a.
(Monad m, Subst a) =>
NamesT m (AbsN a) -> [NamesT m (SubstArg a)] -> NamesT m a
`applyN` [NamesT (TCMT IO) Term
NamesT (TCMT IO) (SubstArg Term)
Var (TCMT IO)
x0]
      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
<$> Abs Term -> NamesT (TCMT IO) (Abs Term)
forall a. a -> NamesT (TCMT IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Abs Term
c 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
    [(NamesT (TCMT IO) Term, NamesT (TCMT IO) Term)]
syse <- NamesT (TCMT IO) (Abs [Term])
-> NamesT
     (TCMT IO) [(NamesT (TCMT IO) Term, NamesT (TCMT IO) Term)]
mkBndry (NamesT (TCMT IO) (Abs [Term])
 -> NamesT
      (TCMT IO) [(NamesT (TCMT IO) Term, NamesT (TCMT IO) Term)])
-> NamesT (TCMT IO) (Abs [Term])
-> NamesT
     (TCMT IO) [(NamesT (TCMT IO) Term, NamesT (TCMT IO) Term)]
forall a b. (a -> b) -> a -> b
$ String
-> (Var (TCMT IO) -> NamesT (TCMT IO) [Term])
-> NamesT (TCMT IO) (Abs [Term])
forall (m :: * -> *) a.
MonadFail m =>
String
-> ((forall b. (Subst b, DeBruijn b) => NamesT m b) -> NamesT m a)
-> NamesT m (Abs a)
bind String
"j" ((Var (TCMT IO) -> NamesT (TCMT IO) [Term])
 -> NamesT (TCMT IO) (Abs [Term]))
-> (Var (TCMT IO) -> NamesT (TCMT IO) [Term])
-> NamesT (TCMT IO) (Abs [Term])
forall a b. (a -> b) -> a -> b
$ \ Var (TCMT IO)
_ -> [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)]
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)]
    NamesT (TCMT IO) Term
w0 <- (Term -> NamesT (TCMT IO) (NamesT (TCMT IO) Term)
forall (m :: * -> *) a.
(MonadFail m, Subst a) =>
a -> NamesT m (NamesT m a)
open (Term -> NamesT (TCMT IO) (NamesT (TCMT IO) Term))
-> NamesT (TCMT IO) Term
-> NamesT (TCMT IO) (NamesT (TCMT IO) Term)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (NamesT (TCMT IO) Term -> NamesT (TCMT IO) (NamesT (TCMT IO) Term))
-> NamesT (TCMT IO) Term
-> NamesT (TCMT IO) (NamesT (TCMT IO) Term)
forall a b. (a -> b) -> a -> b
$ do
      let w :: NamesT (TCMT IO) (Abs Term)
w = NamesT (TCMT IO) (AbsN Term) -> NamesT (TCMT IO) (Abs Term)
mkComp ([String]
-> (Vars (TCMT IO) -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) (AbsN Term)
forall (m :: * -> *) a.
MonadFail m =>
[String] -> (Vars m -> NamesT m a) -> NamesT m (AbsN a)
bindN [String
"i",String
"j"] ((Vars (TCMT IO) -> NamesT (TCMT IO) Term)
 -> NamesT (TCMT IO) (AbsN Term))
-> (Vars (TCMT IO) -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) (AbsN Term)
forall a b. (a -> b) -> a -> b
$ \ [NamesT (TCMT IO) Term
_i, NamesT (TCMT IO) Term
j] -> Abs Term -> Term -> Term
Abs Term -> SubstArg Term -> Term
forall a. Subst a => Abs a -> SubstArg a -> a
absApp (Abs Term -> Term -> Term)
-> NamesT (TCMT IO) (Abs Term) -> NamesT (TCMT IO) (Term -> Term)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamesT (TCMT IO) (Abs Term)
pat_rec NamesT (TCMT IO) (Term -> Term)
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall a b.
NamesT (TCMT IO) (a -> b)
-> NamesT (TCMT IO) a -> NamesT (TCMT IO) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> NamesT (TCMT IO) Term
j)
      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
    let rhs :: NamesT (TCMT IO) Term
rhs = NamesT (TCMT IO) Type
-> [(NamesT (TCMT IO) Term, NamesT (TCMT IO) Term)]
-> NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadReduce m,
 MonadPretty m) =>
NamesT m Type
-> [(NamesT m Term, NamesT m Term)]
-> NamesT m Term
-> NamesT m Term
hcomp (Dom Type -> Type
forall t e. Dom' t e -> e
unDom (Dom Type -> Type)
-> NamesT (TCMT IO) (Dom Type) -> NamesT (TCMT IO) Type
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamesT (TCMT IO) (Dom Type)
rhsTy) [(NamesT (TCMT IO) Term, NamesT (TCMT IO) Term)]
sys NamesT (TCMT IO) Term
w0
    (,,) ([NamedArg DeBruijnPattern]
 -> Dom Type
 -> Term
 -> ([NamedArg DeBruijnPattern], Dom Type, Term))
-> NamesT (TCMT IO) [NamedArg DeBruijnPattern]
-> NamesT
     (TCMT IO)
     (Dom Type -> Term -> ([NamedArg DeBruijnPattern], Dom Type, Term))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamesT (TCMT IO) [NamedArg DeBruijnPattern]
ps NamesT
  (TCMT IO)
  (Dom Type -> Term -> ([NamedArg DeBruijnPattern], Dom Type, Term))
-> NamesT (TCMT IO) (Dom Type)
-> NamesT
     (TCMT IO) (Term -> ([NamedArg DeBruijnPattern], Dom Type, Term))
forall a b.
NamesT (TCMT IO) (a -> b)
-> NamesT (TCMT IO) a -> NamesT (TCMT IO) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> NamesT (TCMT IO) (Dom Type)
rhsTy NamesT
  (TCMT IO) (Term -> ([NamedArg DeBruijnPattern], Dom Type, Term))
-> NamesT (TCMT IO) Term
-> NamesT (TCMT IO) ([NamedArg DeBruijnPattern], Dom Type, Term)
forall a b.
NamesT (TCMT IO) (a -> b)
-> NamesT (TCMT IO) a -> NamesT (TCMT IO) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> NamesT (TCMT IO) Term
rhs
  let ([NamedArg DeBruijnPattern]
ps,Dom Type
ty,Term
rhs) = AbsN ([NamedArg DeBruijnPattern], Dom Type, Term)
-> ([NamedArg DeBruijnPattern], Dom Type, Term)
forall a. AbsN a -> a
unAbsN (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term)
 -> ([NamedArg DeBruijnPattern], Dom Type, Term))
-> AbsN ([NamedArg DeBruijnPattern], Dom Type, Term)
-> ([NamedArg DeBruijnPattern], Dom Type, Term)
forall a b. (a -> b) -> a -> b
$ Abs (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term))
-> AbsN ([NamedArg DeBruijnPattern], Dom Type, Term)
forall a. Abs a -> a
unAbs (Abs (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term))
 -> AbsN ([NamedArg DeBruijnPattern], Dom Type, Term))
-> Abs (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term))
-> AbsN ([NamedArg DeBruijnPattern], Dom Type, Term)
forall a b. (a -> b) -> a -> b
$ AbsN (Abs (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term)))
-> Abs (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term))
forall a. AbsN a -> a
unAbsN (AbsN (Abs (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term)))
 -> Abs (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term)))
-> AbsN (Abs (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term)))
-> Abs (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term))
forall a b. (a -> b) -> a -> b
$ Abs
  (AbsN (Abs (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term))))
-> AbsN (Abs (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term)))
forall a. Abs a -> a
unAbs (Abs
   (AbsN (Abs (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term))))
 -> AbsN (Abs (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term))))
-> Abs
     (AbsN (Abs (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term))))
-> AbsN (Abs (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term)))
forall a b. (a -> b) -> a -> b
$ AbsN
  (Abs
     (AbsN (Abs (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term)))))
-> Abs
     (AbsN (Abs (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term))))
forall a. AbsN a -> a
unAbsN (AbsN
   (Abs
      (AbsN (Abs (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term)))))
 -> Abs
      (AbsN (Abs (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term)))))
-> AbsN
     (Abs
        (AbsN (Abs (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term)))))
-> Abs
     (AbsN (Abs (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term))))
forall a b. (a -> b) -> a -> b
$ Abs
  (AbsN
     (Abs
        (AbsN (Abs (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term))))))
-> AbsN
     (Abs
        (AbsN (Abs (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term)))))
forall a. Abs a -> a
unAbs (Abs
   (AbsN
      (Abs
         (AbsN (Abs (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term))))))
 -> AbsN
      (Abs
         (AbsN (Abs (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term))))))
-> Abs
     (AbsN
        (Abs
           (AbsN (Abs (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term))))))
-> AbsN
     (Abs
        (AbsN (Abs (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term)))))
forall a b. (a -> b) -> a -> b
$ AbsN
  (Abs
     (AbsN
        (Abs
           (AbsN (Abs (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term)))))))
-> Abs
     (AbsN
        (Abs
           (AbsN (Abs (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term))))))
forall a. AbsN a -> a
unAbsN (AbsN
   (Abs
      (AbsN
         (Abs
            (AbsN (Abs (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term)))))))
 -> Abs
      (AbsN
         (Abs
            (AbsN (Abs (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term)))))))
-> AbsN
     (Abs
        (AbsN
           (Abs
              (AbsN (Abs (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term)))))))
-> Abs
     (AbsN
        (Abs
           (AbsN (Abs (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term))))))
forall a b. (a -> b) -> a -> b
$ AbsN
  (Abs
     (AbsN
        (Abs
           (AbsN (Abs (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term)))))))
ps_ty_rhs
  String -> Int -> TCMT IO Doc -> TCMT IO ()
forall (m :: * -> *).
MonadDebug m =>
String -> Int -> TCMT IO Doc -> m ()
reportSDoc String
"tc.cover.trx.trx" Int
20 (TCMT IO Doc -> TCMT IO ()) -> TCMT IO Doc -> TCMT IO ()
forall a b. (a -> b) -> a -> b
$ TCMT IO Doc
"trX-trX clause for" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> QName -> TCMT IO Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
forall (m :: * -> *). MonadPretty m => QName -> m Doc
prettyTCM QName
f
  let c :: Clause
c = Clause { clauseLHSRange :: Range
clauseLHSRange  = Range
forall a. Range' a
noRange
                 , clauseFullRange :: Range
clauseFullRange = Range
forall a. Range' a
noRange
                 , clauseTel :: Telescope
clauseTel       = Telescope
cTel
                 , namedClausePats :: [NamedArg DeBruijnPattern]
namedClausePats = [NamedArg DeBruijnPattern]
ps
                 , clauseBody :: Maybe Term
clauseBody      = Term -> Maybe Term
forall a. a -> Maybe a
Just Term
rhs
                 , clauseType :: Maybe (Arg Type)
clauseType      = Arg Type -> Maybe (Arg Type)
forall a. a -> Maybe a
Just (Arg Type -> Maybe (Arg Type)) -> Arg Type -> Maybe (Arg Type)
forall a b. (a -> b) -> a -> b
$ ArgInfo -> Type -> Arg Type
forall e. ArgInfo -> e -> Arg e
Arg (Dom Type -> ArgInfo
forall a. LensArgInfo a => a -> ArgInfo
getArgInfo Dom Type
ty) (Dom Type -> Type
forall t e. Dom' t e -> e
unDom Dom Type
ty)
                 , clauseCatchall :: Bool
clauseCatchall    = Bool
False
                 , clauseExact :: Maybe Bool
clauseExact       = Maybe Bool
forall a. Maybe a
Nothing
                 , clauseRecursive :: Maybe Bool
clauseRecursive   = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True
                 , clauseUnreachable :: Maybe Bool
clauseUnreachable = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False
                 , clauseEllipsis :: ExpandedEllipsis
clauseEllipsis    = ExpandedEllipsis
NoEllipsis
                 , clauseWhereModule :: Maybe ModuleName
clauseWhereModule = Maybe ModuleName
forall a. Maybe a
Nothing
                 }
  String -> Clause -> TCMT IO ()
debugClause String
"tc.cover.trx.trx" Clause
c
  Clause -> TCM Clause
forall a. a -> TCMT IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Clause -> TCM Clause) -> Clause -> TCM Clause
forall a b. (a -> b) -> a -> b
$ Clause
c
createMissingTrXHCompClause :: QName
                            -> QName
                            -> Arg Nat
                            -> BlockingVar
                            -> SplitClause
                            -> TCM Clause
createMissingTrXHCompClause :: QName
-> QName -> Arg Int -> BlockingVar -> SplitClause -> TCM Clause
createMissingTrXHCompClause QName
q_trX QName
f Arg Int
n BlockingVar
x SplitClause
old_sc = do
  let
   old_tel :: Telescope
old_tel = SplitClause -> Telescope
scTel SplitClause
old_sc
   old_ps :: [NamedArg DeBruijnPattern]
old_ps = [NamedArg SplitPattern] -> [NamedArg DeBruijnPattern]
fromSplitPatterns ([NamedArg SplitPattern] -> [NamedArg DeBruijnPattern])
-> [NamedArg SplitPattern] -> [NamedArg DeBruijnPattern]
forall a b. (a -> b) -> a -> b
$ SplitClause -> [NamedArg SplitPattern]
scPats SplitClause
old_sc
   old_t :: Dom Type
old_t = Dom Type -> Maybe (Dom Type) -> Dom Type
forall a. a -> Maybe a -> a
fromMaybe Dom Type
forall a. HasCallStack => a
__IMPOSSIBLE__ (Maybe (Dom Type) -> Dom Type) -> Maybe (Dom Type) -> Dom Type
forall a b. (a -> b) -> a -> b
$ SplitClause -> Maybe (Dom Type)
scTarget SplitClause
old_sc

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

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

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

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

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

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

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

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

  QName
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 :: Telescope
old_tel = SplitClause -> Telescope
scTel SplitClause
old_sc
   old_ps :: [NamedArg DeBruijnPattern]
old_ps = [NamedArg SplitPattern] -> [NamedArg DeBruijnPattern]
fromSplitPatterns ([NamedArg SplitPattern] -> [NamedArg DeBruijnPattern])
-> [NamedArg SplitPattern] -> [NamedArg DeBruijnPattern]
forall a b. (a -> b) -> a -> b
$ SplitClause -> [NamedArg SplitPattern]
scPats SplitClause
old_sc
   old_t :: Dom Type
old_t = Dom Type -> Maybe (Dom Type) -> Dom Type
forall a. a -> Maybe a -> a
fromMaybe Dom Type
forall a. HasCallStack => a
__IMPOSSIBLE__ (Maybe (Dom Type) -> Dom Type) -> Maybe (Dom Type) -> Dom Type
forall a b. (a -> b) -> a -> b
$ SplitClause -> Maybe (Dom Type)
scTarget SplitClause
old_sc

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

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

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

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

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

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

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

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

  AbsN [(Term, Term)]
old_sides <- AbsN [NamedArg DeBruijnPattern]
-> ([NamedArg DeBruijnPattern] -> TCMT IO [(Term, Term)])
-> TCMT IO (AbsN [(Term, Term)])
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM AbsN [NamedArg DeBruijnPattern]
old_ps' (([NamedArg DeBruijnPattern] -> TCMT IO [(Term, Term)])
 -> TCMT IO (AbsN [(Term, Term)]))
-> ([NamedArg DeBruijnPattern] -> TCMT IO [(Term, Term)])
-> TCMT IO (AbsN [(Term, Term)])
forall a b. (a -> b) -> a -> b
$ \ [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
    [(Term, (Term, Term))]
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)
    [(Term, Term)] -> TCMT IO [(Term, Term)]
forall a. a -> TCMT IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Term, Term)] -> TCMT IO [(Term, Term)])
-> [(Term, Term)] -> TCMT IO [(Term, Term)]
forall a b. (a -> b) -> a -> b
$ ((Term, (Term, Term)) -> [(Term, Term)])
-> [(Term, (Term, Term))] -> [(Term, Term)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(Term
v,(Term
l,Term
r)) -> [(Term
tNeg Term -> Args -> Term
forall t. Apply t => t -> Args -> t
`apply` [Term -> Arg Term
forall e. e -> Arg e
argN Term
v],Term
l),(Term
v,Term
r)]) [(Term, (Term, Term))]
xs
  let
    gamma1ArgNames :: [Arg String]
gamma1ArgNames = Telescope -> [Arg String]
teleArgNames Telescope
gamma1
    deltaArgNames :: [Arg String]
deltaArgNames = Telescope -> [Arg String]
teleArgNames Telescope
delta'
  (AbsN Args
params,AbsN Telescope
xTel,AbsN (AbsN Type)
dT) <- Telescope
-> TCMT IO (AbsN Args, AbsN Telescope, AbsN (AbsN Type))
-> TCMT IO (AbsN Args, AbsN Telescope, AbsN (AbsN Type))
forall b (m :: * -> *) a.
(AddContext b, MonadAddContext m) =>
b -> m a -> m a
forall (m :: * -> *) a.
MonadAddContext m =>
Telescope -> m a -> m a
addContext Telescope
gamma1 (TCMT IO (AbsN Args, AbsN Telescope, AbsN (AbsN Type))
 -> TCMT IO (AbsN Args, AbsN Telescope, AbsN (AbsN Type)))
-> TCMT IO (AbsN Args, AbsN Telescope, AbsN (AbsN Type))
-> TCMT IO (AbsN Args, AbsN Telescope, AbsN (AbsN Type))
forall a b. (a -> b) -> a -> b
$ do
    Just (QName
d, Args
ps, Args
_is) <- Type -> TCMT IO (Maybe (QName, Args, Args))
forall (m :: * -> *).
HasConstInfo m =>
Type -> m (Maybe (QName, Args, Args))
getDatatypeArgs (Type -> TCMT IO (Maybe (QName, Args, Args)))
-> (Dom Type -> Type)
-> Dom Type
-> TCMT IO (Maybe (QName, Args, Args))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dom Type -> Type
forall t e. Dom' t e -> e
unDom (Dom Type -> TCMT IO (Maybe (QName, Args, Args)))
-> TCMT IO (Dom Type) -> TCMT IO (Maybe (QName, Args, Args))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Dom Type -> TCMT IO (Dom Type)
forall a (m :: * -> *). (Reduce a, MonadReduce m) => a -> m a
reduce Dom Type
dType'
    Definition
def <- QName -> TCMT IO Definition
forall (m :: * -> *). HasConstInfo m => QName -> m Definition
getConstInfo QName
d
    let dTy :: Type
dTy = Definition -> Type
defType Definition
def
    let Datatype{dataSort :: Defn -> Sort
dataSort = Sort
s} = Definition -> Defn
theDef Definition
def
    TelV Telescope
tel Type
_ <- Type -> TCMT IO (TelV Type)
forall (m :: * -> *).
(MonadReduce m, MonadAddContext m) =>
Type -> m (TelV Type)
telView Type
dTy
    let params :: AbsN Args
params = [String] -> Args -> AbsN Args
forall a. [String] -> a -> AbsN a
AbsN (Telescope -> [String]
teleNames Telescope
gamma1) Args
ps
        xTel :: AbsN Telescope
xTel = [String] -> Telescope -> AbsN Telescope
forall a. [String] -> a -> AbsN a
AbsN (Telescope -> [String]
teleNames Telescope
gamma1) (Telescope
tel Telescope -> Args -> Telescope
forall t. Apply t => t -> Args -> t
`apply` Args
ps)

    AbsN (AbsN Type)
dT <- [String]
-> NamesT (TCMT IO) (AbsN (AbsN Type))
-> TCMT IO (AbsN (AbsN Type))
forall (m :: * -> *) a. [String] -> NamesT m a -> m a
runNamesT [] (NamesT (TCMT IO) (AbsN (AbsN Type)) -> TCMT IO (AbsN (AbsN Type)))
-> NamesT (TCMT IO) (AbsN (AbsN Type))
-> TCMT IO (AbsN (AbsN Type))
forall a b. (a -> b) -> a -> b
$ do
          NamesT (TCMT IO) (AbsN Sort)
s <- AbsN Sort -> NamesT (TCMT IO) (NamesT (TCMT IO) (AbsN Sort))
forall (m :: * -> *) a.
(MonadFail m, Subst a) =>
a -> NamesT m (NamesT m a)
open (AbsN Sort -> NamesT (TCMT IO) (NamesT (TCMT IO) (AbsN Sort)))
-> AbsN Sort -> NamesT (TCMT IO) (NamesT (TCMT IO) (AbsN Sort))
forall a b. (a -> b) -> a -> b
$ [String] -> Sort -> AbsN Sort
forall a. [String] -> a -> AbsN a
AbsN (Telescope -> [String]
teleNames Telescope
tel) Sort
s
          [Arg String]
-> (ArgVars (TCMT IO) -> NamesT (TCMT IO) (AbsN Type))
-> NamesT (TCMT IO) (AbsN (AbsN Type))
forall (m :: * -> *) a.
MonadFail m =>
[Arg String] -> (ArgVars m -> NamesT m a) -> NamesT m (AbsN a)
bindNArg (Telescope -> [Arg String]
teleArgNames Telescope
gamma1) ((ArgVars (TCMT IO) -> NamesT (TCMT IO) (AbsN Type))
 -> NamesT (TCMT IO) (AbsN (AbsN Type)))
-> (ArgVars (TCMT IO) -> NamesT (TCMT IO) (AbsN Type))
-> NamesT (TCMT IO) (AbsN (AbsN Type))
forall a b. (a -> b) -> a -> b
$ \ ArgVars (TCMT IO)
g1 -> do
          [Arg String]
-> (ArgVars (TCMT IO) -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) (AbsN Type)
forall (m :: * -> *) a.
MonadFail m =>
[Arg String] -> (ArgVars m -> NamesT m a) -> NamesT m (AbsN a)
bindNArg (Telescope -> [Arg String]
teleArgNames (Telescope -> [Arg String]) -> Telescope -> [Arg String]
forall a b. (a -> b) -> a -> b
$ AbsN Telescope -> Telescope
forall a. AbsN a -> a
unAbsN AbsN Telescope
xTel) ((ArgVars (TCMT IO) -> NamesT (TCMT IO) Type)
 -> NamesT (TCMT IO) (AbsN Type))
-> (ArgVars (TCMT IO) -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) (AbsN Type)
forall a b. (a -> b) -> a -> b
$ \ ArgVars (TCMT IO)
x -> do
          Args
params <- AbsN Args -> NamesT (TCMT IO) (AbsN Args)
forall a. a -> NamesT (TCMT IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure AbsN Args
params NamesT (TCMT IO) (AbsN Args)
-> [NamesT (TCMT IO) (SubstArg Args)] -> NamesT (TCMT IO) Args
forall (m :: * -> *) a.
(Monad m, Subst a) =>
NamesT m (AbsN a) -> [NamesT m (SubstArg a)] -> NamesT m a
`applyN` ((Arg Term -> Term)
-> NamesT (TCMT IO) (Arg Term) -> NamesT (TCMT IO) Term
forall a b. (a -> b) -> NamesT (TCMT IO) a -> NamesT (TCMT IO) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Arg Term -> Term
forall e. Arg e -> e
unArg (NamesT (TCMT IO) (Arg Term) -> NamesT (TCMT IO) Term)
-> [NamesT (TCMT IO) (Arg Term)] -> [NamesT (TCMT IO) Term]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [NamesT (TCMT IO) (Arg Term)]
ArgVars (TCMT IO)
g1)
          Args
x      <- [NamesT (TCMT IO) (Arg Term)] -> NamesT (TCMT IO) Args
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence [NamesT (TCMT IO) (Arg Term)]
ArgVars (TCMT IO)
x
          Sort
s <- NamesT (TCMT IO) (AbsN Sort)
s NamesT (TCMT IO) (AbsN Sort)
-> [NamesT (TCMT IO) (SubstArg Sort)] -> NamesT (TCMT IO) Sort
forall (m :: * -> *) a.
(Monad m, Subst a) =>
NamesT m (AbsN a) -> [NamesT m (SubstArg a)] -> NamesT m a
`applyN` ((Arg Term -> NamesT (TCMT IO) (SubstArg Sort))
-> Args -> [NamesT (TCMT IO) (SubstArg Sort)]
forall a b. (a -> b) -> [a] -> [b]
map (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)
-> (Arg Term -> Term) -> Arg Term -> NamesT (TCMT IO) Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Arg Term -> Term
forall e. Arg e -> e
unArg) (Args -> [NamesT (TCMT IO) (SubstArg Sort)])
-> Args -> [NamesT (TCMT IO) (SubstArg Sort)]
forall a b. (a -> b) -> a -> b
$ Args
params Args -> Args -> Args
forall a. [a] -> [a] -> [a]
++ Args
x)
          Type -> NamesT (TCMT IO) Type
forall a. a -> NamesT (TCMT IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Type -> NamesT (TCMT IO) Type) -> Type -> NamesT (TCMT IO) Type
forall a b. (a -> b) -> a -> b
$ Sort -> Term -> Type
forall t a. Sort' t -> a -> Type'' t a
El Sort
s (Term -> Type) -> Term -> Type
forall a b. (a -> b) -> a -> b
$ QName -> [Elim] -> Term
Def QName
d [] Term -> Args -> Term
forall t. Apply t => t -> Args -> t
`apply` (Args
params Args -> Args -> Args
forall a. [a] -> [a] -> [a]
++ Args
x)
    (AbsN Args, AbsN Telescope, AbsN (AbsN Type))
-> TCMT IO (AbsN Args, AbsN Telescope, AbsN (AbsN Type))
forall a. a -> TCMT IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ((AbsN Args, AbsN Telescope, AbsN (AbsN Type))
 -> TCMT IO (AbsN Args, AbsN Telescope, AbsN (AbsN Type)))
-> (AbsN Args, AbsN Telescope, AbsN (AbsN Type))
-> TCMT IO (AbsN Args, AbsN Telescope, AbsN (AbsN Type))
forall a b. (a -> b) -> a -> b
$ (AbsN Args
params, AbsN Telescope
xTel,AbsN (AbsN Type)
dT)

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

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

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

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

    NamesT (TCMT IO) Telescope
xTel <- (Telescope -> NamesT (TCMT IO) (NamesT (TCMT IO) Telescope)
forall (m :: * -> *) a.
(MonadFail m, Subst a) =>
a -> NamesT m (NamesT m a)
open (Telescope -> NamesT (TCMT IO) (NamesT (TCMT IO) Telescope))
-> NamesT (TCMT IO) Telescope
-> NamesT (TCMT IO) (NamesT (TCMT IO) Telescope)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (NamesT (TCMT IO) Telescope
 -> NamesT (TCMT IO) (NamesT (TCMT IO) Telescope))
-> NamesT (TCMT IO) Telescope
-> NamesT (TCMT IO) (NamesT (TCMT IO) Telescope)
forall a b. (a -> b) -> a -> b
$ AbsN Telescope -> NamesT (TCMT IO) (AbsN Telescope)
forall a. a -> NamesT (TCMT IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure AbsN Telescope
xTel NamesT (TCMT IO) (AbsN Telescope)
-> [NamesT (TCMT IO) (SubstArg Telescope)]
-> NamesT (TCMT IO) Telescope
forall (m :: * -> *) a.
(Monad m, Subst a) =>
NamesT m (AbsN a) -> [NamesT m (SubstArg a)] -> NamesT m a
`applyN` [NamesT (TCMT IO) Term]
[NamesT (TCMT IO) (SubstArg Telescope)]
Vars (TCMT IO)
g1
    -- Ξ ⊢ pat-rec[i] := trX .. (hfill ... (~ i))
    NamesT (TCMT IO) (Abs Term)
pat_rec <- (Abs Term -> NamesT (TCMT IO) (NamesT (TCMT IO) (Abs Term))
forall (m :: * -> *) a.
(MonadFail m, Subst a) =>
a -> NamesT m (NamesT m a)
open (Abs Term -> NamesT (TCMT IO) (NamesT (TCMT IO) (Abs Term)))
-> NamesT (TCMT IO) (Abs Term)
-> NamesT (TCMT IO) (NamesT (TCMT IO) (Abs Term))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (NamesT (TCMT IO) (Abs Term)
 -> NamesT (TCMT IO) (NamesT (TCMT IO) (Abs Term)))
-> NamesT (TCMT IO) (Abs Term)
-> NamesT (TCMT IO) (NamesT (TCMT IO) (Abs Term))
forall a b. (a -> b) -> a -> b
$ String
-> (Var (TCMT IO) -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) (Abs Term)
forall (m :: * -> *) a.
MonadFail m =>
String
-> ((forall b. (Subst b, DeBruijn b) => NamesT m b) -> NamesT m a)
-> NamesT m (Abs a)
bind String
"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
          let tr :: NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
tr NamesT (TCMT IO) Term
x = NamesT (TCMT IO) (AbsN (AbsN (AbsN Term)))
trX NamesT (TCMT IO) (AbsN (AbsN (AbsN Term)))
-> [NamesT (TCMT IO) (SubstArg (AbsN (AbsN Term)))]
-> NamesT (TCMT IO) (AbsN (AbsN Term))
forall (m :: * -> *) a.
(Monad m, Subst a) =>
NamesT m (AbsN a) -> [NamesT m (SubstArg a)] -> NamesT m a
`applyN` [NamesT (TCMT IO) Term]
[NamesT (TCMT IO) (SubstArg (AbsN (AbsN Term)))]
Vars (TCMT IO)
g1 NamesT (TCMT IO) (AbsN (AbsN Term))
-> [NamesT (TCMT IO) (SubstArg (AbsN Term))]
-> NamesT (TCMT IO) (AbsN Term)
forall (m :: * -> *) a.
(Monad m, Subst a) =>
NamesT m (AbsN a) -> [NamesT m (SubstArg a)] -> NamesT m a
`applyN` (NamesT (TCMT IO) Term
Var (TCMT IO)
phiNamesT (TCMT IO) Term
-> [NamesT (TCMT IO) Term] -> [NamesT (TCMT IO) Term]
forall a. a -> [a] -> [a]
:[NamesT (TCMT IO) Term]
Vars (TCMT IO)
p) NamesT (TCMT IO) (AbsN Term)
-> [NamesT (TCMT IO) (SubstArg Term)] -> NamesT (TCMT IO) Term
forall (m :: * -> *) a.
(Monad m, Subst a) =>
NamesT m (AbsN a) -> [NamesT m (SubstArg a)] -> NamesT m a
`applyN` [NamesT (TCMT IO) Term
NamesT (TCMT IO) (SubstArg Term)
x]
          let p0 :: [NamesT (TCMT IO) Term]
p0 = [NamesT (TCMT IO) Term]
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> [NamesT (TCMT IO) Term]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
for [NamesT (TCMT IO) Term]
Vars (TCMT IO)
p ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
 -> [NamesT (TCMT IO) Term])
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> [NamesT (TCMT IO) Term]
forall a b. (a -> b) -> a -> b
$ \ NamesT (TCMT IO) Term
p -> NamesT (TCMT IO) Term
p NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> Term -> NamesT (TCMT IO) Term
forall a. a -> NamesT (TCMT IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
iz
          NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
tr (NamesT (TCMT IO) Type
-> [(NamesT (TCMT IO) Term, NamesT (TCMT IO) Term)]
-> NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadReduce m,
 MonadPretty m) =>
NamesT m Type
-> [(NamesT m Term, NamesT m Term)]
-> NamesT m Term
-> NamesT m Term
hcomp (AbsN (AbsN Type) -> NamesT (TCMT IO) (AbsN (AbsN Type))
forall a. a -> NamesT (TCMT IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure AbsN (AbsN Type)
dT NamesT (TCMT IO) (AbsN (AbsN Type))
-> [NamesT (TCMT IO) (SubstArg (AbsN Type))]
-> NamesT (TCMT IO) (AbsN Type)
forall (m :: * -> *) a.
(Monad m, Subst a) =>
NamesT m (AbsN a) -> [NamesT m (SubstArg a)] -> NamesT m a
`applyN` [NamesT (TCMT IO) Term]
[NamesT (TCMT IO) (SubstArg (AbsN Type))]
Vars (TCMT IO)
g1 NamesT (TCMT IO) (AbsN Type)
-> [NamesT (TCMT IO) (SubstArg Type)] -> NamesT (TCMT IO) Type
forall (m :: * -> *) a.
(Monad m, Subst a) =>
NamesT m (AbsN a) -> [NamesT m (SubstArg a)] -> NamesT m a
`applyN` [NamesT (TCMT IO) Term]
[NamesT (TCMT IO) (SubstArg Type)]
p0)
                    [(NamesT (TCMT IO) Term
Var (TCMT IO)
psi,String
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
lam String
"j" ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
 -> NamesT (TCMT IO) Term)
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall a b. (a -> b) -> a -> b
$ \ NamesT (TCMT IO) Term
j -> NamesT (TCMT IO) Term
Var (TCMT IO)
u NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> (NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall {m :: * -> *}.
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
NamesT m Term -> NamesT m Term -> NamesT m Term
min NamesT (TCMT IO) Term
j (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
neg NamesT (TCMT IO) Term
Var (TCMT IO)
i)))
                    ,(NamesT (TCMT IO) Term
Var (TCMT IO)
i  ,String
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
lam String
"j" ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
 -> NamesT (TCMT IO) Term)
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall a b. (a -> b) -> a -> b
$ \ NamesT (TCMT IO) Term
_ -> String
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
ilam String
"o" ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
 -> NamesT (TCMT IO) Term)
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall a b. (a -> b) -> a -> b
$ \ NamesT (TCMT IO) Term
_ -> NamesT (TCMT IO) Term
Var (TCMT IO)
u0)]
                    NamesT (TCMT IO) Term
Var (TCMT IO)
u0)
    --   args : (i.old_tel)  -> ...
    let mkBndry :: NamesT (TCMT IO) (Abs [Term])
-> NamesT
     (TCMT IO) [(NamesT (TCMT IO) Term, NamesT (TCMT IO) Term)]
mkBndry NamesT (TCMT IO) (Abs [Term])
args = do
            [NamesT (TCMT IO) Term]
args1 <- ((Term -> NamesT (TCMT IO) (NamesT (TCMT IO) Term))
-> [Term] -> NamesT (TCMT IO) [NamesT (TCMT IO) Term]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Term -> NamesT (TCMT IO) (NamesT (TCMT IO) Term)
forall (m :: * -> *) a.
(MonadFail m, Subst a) =>
a -> NamesT m (NamesT m a)
open ([Term] -> NamesT (TCMT IO) [NamesT (TCMT IO) Term])
-> NamesT (TCMT IO) [Term]
-> NamesT (TCMT IO) [NamesT (TCMT IO) Term]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (NamesT (TCMT IO) [Term]
 -> NamesT (TCMT IO) [NamesT (TCMT IO) Term])
-> NamesT (TCMT IO) [Term]
-> NamesT (TCMT IO) [NamesT (TCMT IO) Term]
forall a b. (a -> b) -> a -> b
$ (Abs [Term] -> Term -> [Term]
Abs [Term] -> SubstArg [Term] -> [Term]
forall a. Subst a => Abs a -> SubstArg a -> a
absApp (Abs [Term] -> Term -> [Term])
-> NamesT (TCMT IO) (Abs [Term])
-> NamesT (TCMT IO) (Term -> [Term])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamesT (TCMT IO) (Abs [Term])
args NamesT (TCMT IO) (Term -> [Term])
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) [Term]
forall a b.
NamesT (TCMT IO) (a -> b)
-> NamesT (TCMT IO) a -> NamesT (TCMT IO) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Term -> NamesT (TCMT IO) Term
forall a. a -> NamesT (TCMT IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
io)
            -- faces ought to be constant on "j"
            [Term]
faces <- AbsN [Term] -> NamesT (TCMT IO) (AbsN [Term])
forall a. a -> NamesT (TCMT IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (([(Term, Term)] -> [Term]) -> AbsN [(Term, Term)] -> AbsN [Term]
forall a b. (a -> b) -> AbsN a -> AbsN b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((Term, Term) -> Term) -> [(Term, Term)] -> [Term]
forall a b. (a -> b) -> [a] -> [b]
map (Term, Term) -> Term
forall a b. (a, b) -> a
fst) AbsN [(Term, Term)]
old_sides) 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])]
args1
            [Term]
us <- [AbsN Term]
-> (AbsN Term -> NamesT (TCMT IO) Term) -> NamesT (TCMT IO) [Term]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (([(Term, Term)] -> [Term]) -> AbsN [(Term, Term)] -> [AbsN 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) -> AbsN a -> m (AbsN b)
mapM (((Term, Term) -> Term) -> [(Term, Term)] -> [Term]
forall a b. (a -> b) -> [a] -> [b]
map (Term, Term) -> Term
forall a b. (a, b) -> b
snd) AbsN [(Term, Term)]
old_sides) ((AbsN Term -> NamesT (TCMT IO) Term) -> NamesT (TCMT IO) [Term])
-> (AbsN Term -> NamesT (TCMT IO) Term) -> NamesT (TCMT IO) [Term]
forall a b. (a -> b) -> a -> b
$ \ AbsN Term
u -> do
                  String
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
lam String
"j" ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
 -> NamesT (TCMT IO) Term)
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall a b. (a -> b) -> a -> b
$ \ NamesT (TCMT IO) Term
j -> String
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
ilam String
"o" ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
 -> NamesT (TCMT IO) Term)
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall a b. (a -> b) -> a -> b
$ \ NamesT (TCMT IO) Term
_ -> do
                    [NamesT (TCMT IO) Term]
args <- ((Term -> NamesT (TCMT IO) (NamesT (TCMT IO) Term))
-> [Term] -> NamesT (TCMT IO) [NamesT (TCMT IO) Term]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Term -> NamesT (TCMT IO) (NamesT (TCMT IO) Term)
forall (m :: * -> *) a.
(MonadFail m, Subst a) =>
a -> NamesT m (NamesT m a)
open ([Term] -> NamesT (TCMT IO) [NamesT (TCMT IO) Term])
-> NamesT (TCMT IO) [Term]
-> NamesT (TCMT IO) [NamesT (TCMT IO) Term]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (NamesT (TCMT IO) [Term]
 -> NamesT (TCMT IO) [NamesT (TCMT IO) Term])
-> NamesT (TCMT IO) [Term]
-> NamesT (TCMT IO) [NamesT (TCMT IO) Term]
forall a b. (a -> b) -> a -> b
$ (Abs [Term] -> Term -> [Term]
Abs [Term] -> SubstArg [Term] -> [Term]
forall a. Subst a => Abs a -> SubstArg a -> a
absApp (Abs [Term] -> Term -> [Term])
-> NamesT (TCMT IO) (Abs [Term])
-> NamesT (TCMT IO) (Term -> [Term])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamesT (TCMT IO) (Abs [Term])
args NamesT (TCMT IO) (Term -> [Term])
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) [Term]
forall a b.
NamesT (TCMT IO) (a -> b)
-> NamesT (TCMT IO) a -> NamesT (TCMT IO) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> NamesT (TCMT IO) Term
j)
                    AbsN Term -> NamesT (TCMT IO) (AbsN Term)
forall a. a -> NamesT (TCMT IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure AbsN Term
u 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)]
args
            [(Term, Term)]
-> ((Term, Term)
    -> NamesT (TCMT IO) (NamesT (TCMT IO) Term, NamesT (TCMT IO) Term))
-> NamesT
     (TCMT IO) [(NamesT (TCMT IO) Term, NamesT (TCMT IO) Term)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM ([Term] -> [Term] -> [(Term, Term)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Term]
faces [Term]
us) (((Term, Term)
  -> NamesT (TCMT IO) (NamesT (TCMT IO) Term, NamesT (TCMT IO) Term))
 -> NamesT
      (TCMT IO) [(NamesT (TCMT IO) Term, NamesT (TCMT IO) Term)])
-> ((Term, Term)
    -> NamesT (TCMT IO) (NamesT (TCMT IO) Term, NamesT (TCMT IO) Term))
-> NamesT
     (TCMT IO) [(NamesT (TCMT IO) Term, NamesT (TCMT IO) Term)]
forall a b. (a -> b) -> a -> b
$ \ (Term
phi,Term
u) -> (NamesT (TCMT IO) Term
 -> NamesT (TCMT IO) Term
 -> (NamesT (TCMT IO) Term, NamesT (TCMT IO) Term))
-> NamesT (TCMT IO) (NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) (NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) (NamesT (TCMT IO) Term, NamesT (TCMT IO) Term)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (,) (Term -> NamesT (TCMT IO) (NamesT (TCMT IO) Term)
forall (m :: * -> *) a.
(MonadFail m, Subst a) =>
a -> NamesT m (NamesT m a)
open Term
phi) (Term -> NamesT (TCMT IO) (NamesT (TCMT IO) Term)
forall (m :: * -> *) a.
(MonadFail m, Subst a) =>
a -> NamesT m (NamesT m a)
open Term
u)
    Term
rhs <- do
      NamesT (TCMT IO) (Abs [Term])
d_f <- (Abs [Term] -> NamesT (TCMT IO) (NamesT (TCMT IO) (Abs [Term]))
forall (m :: * -> *) a.
(MonadFail m, Subst a) =>
a -> NamesT m (NamesT m a)
open (Abs [Term] -> NamesT (TCMT IO) (NamesT (TCMT IO) (Abs [Term])))
-> NamesT (TCMT IO) (Abs [Term])
-> NamesT (TCMT IO) (NamesT (TCMT IO) (Abs [Term]))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (NamesT (TCMT IO) (Abs [Term])
 -> NamesT (TCMT IO) (NamesT (TCMT IO) (Abs [Term])))
-> NamesT (TCMT IO) (Abs [Term])
-> NamesT (TCMT IO) (NamesT (TCMT IO) (Abs [Term]))
forall a b. (a -> b) -> a -> b
$ String
-> (Var (TCMT IO) -> NamesT (TCMT IO) [Term])
-> NamesT (TCMT IO) (Abs [Term])
forall (m :: * -> *) a.
MonadFail m =>
String
-> ((forall b. (Subst b, DeBruijn b) => NamesT m b) -> NamesT m a)
-> NamesT m (Abs a)
bind String
"j" ((Var (TCMT IO) -> NamesT (TCMT IO) [Term])
 -> NamesT (TCMT IO) (Abs [Term]))
-> (Var (TCMT IO) -> NamesT (TCMT IO) [Term])
-> NamesT (TCMT IO) (Abs [Term])
forall a b. (a -> b) -> a -> b
$ \ Var (TCMT IO)
j -> do
        Abs Telescope
tel <- String
-> (Var (TCMT IO) -> NamesT (TCMT IO) Telescope)
-> NamesT (TCMT IO) (Abs Telescope)
forall (m :: * -> *) a.
MonadFail m =>
String
-> ((forall b. (Subst b, DeBruijn b) => NamesT m b) -> NamesT m a)
-> NamesT m (Abs a)
bind String
"j" ((Var (TCMT IO) -> NamesT (TCMT IO) Telescope)
 -> NamesT (TCMT IO) (Abs Telescope))
-> (Var (TCMT IO) -> NamesT (TCMT IO) Telescope)
-> NamesT (TCMT IO) (Abs Telescope)
forall a b. (a -> b) -> a -> b
$ \ Var (TCMT IO)
j -> NamesT (TCMT IO) (AbsN Telescope)
delta NamesT (TCMT IO) (AbsN Telescope)
-> [NamesT (TCMT IO) (SubstArg Telescope)]
-> NamesT (TCMT IO) Telescope
forall (m :: * -> *) a.
(Monad m, Subst a) =>
NamesT m (AbsN a) -> [NamesT m (SubstArg a)] -> NamesT m a
`applyN` ([NamesT (TCMT IO) Term]
Vars (TCMT IO)
g1 [NamesT (TCMT IO) Term]
-> [NamesT (TCMT IO) Term] -> [NamesT (TCMT IO) Term]
forall a. [a] -> [a] -> [a]
++ [Abs Term -> Term -> Term
Abs Term -> SubstArg Term -> Term
forall a. Subst a => Abs a -> SubstArg a -> a
absApp (Abs Term -> Term -> Term)
-> NamesT (TCMT IO) (Abs Term) -> NamesT (TCMT IO) (Term -> Term)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamesT (TCMT IO) (Abs Term)
pat_rec NamesT (TCMT IO) (Term -> Term)
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall a b.
NamesT (TCMT IO) (a -> b)
-> NamesT (TCMT IO) a -> NamesT (TCMT IO) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> NamesT (TCMT IO) Term
Var (TCMT IO)
j])
        let face :: Term
face = Term
iz
        Term
j <- NamesT (TCMT IO) Term
Var (TCMT IO)
j
        Args
d <- (Term -> Arg Term) -> [Term] -> Args
forall a b. (a -> b) -> [a] -> [b]
map Term -> Arg Term
forall e. e -> Arg e
defaultArg ([Term] -> Args)
-> NamesT (TCMT IO) [Term] -> NamesT (TCMT IO) Args
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [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)
d
        TCM [Term] -> NamesT (TCMT IO) [Term]
forall (m :: * -> *) a. Monad m => m a -> NamesT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (TCM [Term] -> NamesT (TCMT IO) [Term])
-> TCM [Term] -> NamesT (TCMT IO) [Term]
forall a b. (a -> b) -> a -> b
$ QName -> Abs Telescope -> Term -> Args -> Term -> TCM [Term]
covFillTele QName
f Abs Telescope
tel Term
face Args
d Term
j
      let args :: NamesT (TCMT IO) (Abs [Term])
args = String
-> (Var (TCMT IO) -> NamesT (TCMT IO) [Term])
-> NamesT (TCMT IO) (Abs [Term])
forall (m :: * -> *) a.
MonadFail m =>
String
-> ((forall b. (Subst b, DeBruijn b) => NamesT m b) -> NamesT m a)
-> NamesT m (Abs a)
bind String
"j" ((Var (TCMT IO) -> NamesT (TCMT IO) [Term])
 -> NamesT (TCMT IO) (Abs [Term]))
-> (Var (TCMT IO) -> NamesT (TCMT IO) [Term])
-> NamesT (TCMT IO) (Abs [Term])
forall a b. (a -> b) -> a -> b
$ \ Var (TCMT IO)
j -> do
            [Term]
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
            Term
x <- 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 -> NamesT (TCMT IO) Term
neg NamesT (TCMT IO) Term
Var (TCMT IO)
j
            [Term]
ys <- 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])
d_f NamesT (TCMT IO) (Term -> [Term])
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) [Term]
forall a b.
NamesT (TCMT IO) (a -> b)
-> NamesT (TCMT IO) a -> NamesT (TCMT IO) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
neg NamesT (TCMT IO) Term
Var (TCMT IO)
j
            [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
$ [Term]
g1 [Term] -> [Term] -> [Term]
forall a. [a] -> [a] -> [a]
++ Term
xTerm -> [Term] -> [Term]
forall a. a -> [a] -> [a]
:[Term]
ys
      NamesT (TCMT IO) (Abs Type)
ty <- (Abs Type -> NamesT (TCMT IO) (NamesT (TCMT IO) (Abs Type))
forall (m :: * -> *) a.
(MonadFail m, Subst a) =>
a -> NamesT m (NamesT m a)
open (Abs Type -> NamesT (TCMT IO) (NamesT (TCMT IO) (Abs Type)))
-> NamesT (TCMT IO) (Abs Type)
-> NamesT (TCMT IO) (NamesT (TCMT IO) (Abs Type))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (NamesT (TCMT IO) (Abs Type)
 -> NamesT (TCMT IO) (NamesT (TCMT IO) (Abs Type)))
-> NamesT (TCMT IO) (Abs Type)
-> NamesT (TCMT IO) (NamesT (TCMT IO) (Abs Type))
forall a b. (a -> b) -> a -> b
$ String
-> (Var (TCMT IO) -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) (Abs Type)
forall (m :: * -> *) a.
MonadFail m =>
String
-> ((forall b. (Subst b, DeBruijn b) => NamesT m b) -> NamesT m a)
-> NamesT m (Abs a)
bind String
"j" ((Var (TCMT IO) -> NamesT (TCMT IO) Type)
 -> NamesT (TCMT IO) (Abs Type))
-> (Var (TCMT IO) -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) (Abs Type)
forall a b. (a -> b) -> a -> b
$ \ Var (TCMT IO)
j -> do
           [NamesT (TCMT IO) Term]
args <- ((Term -> NamesT (TCMT IO) (NamesT (TCMT IO) Term))
-> [Term] -> NamesT (TCMT IO) [NamesT (TCMT IO) Term]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Term -> NamesT (TCMT IO) (NamesT (TCMT IO) Term)
forall (m :: * -> *) a.
(MonadFail m, Subst a) =>
a -> NamesT m (NamesT m a)
open ([Term] -> NamesT (TCMT IO) [NamesT (TCMT IO) Term])
-> NamesT (TCMT IO) [Term]
-> NamesT (TCMT IO) [NamesT (TCMT IO) Term]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (NamesT (TCMT IO) [Term]
 -> NamesT (TCMT IO) [NamesT (TCMT IO) Term])
-> NamesT (TCMT IO) [Term]
-> NamesT (TCMT IO) [NamesT (TCMT IO) Term]
forall a b. (a -> b) -> a -> b
$ Abs [Term] -> Term -> [Term]
Abs [Term] -> SubstArg [Term] -> [Term]
forall a. Subst a => Abs a -> SubstArg a -> a
absApp (Abs [Term] -> Term -> [Term])
-> NamesT (TCMT IO) (Abs [Term])
-> NamesT (TCMT IO) (Term -> [Term])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamesT (TCMT IO) (Abs [Term])
args NamesT (TCMT IO) (Term -> [Term])
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) [Term]
forall a b.
NamesT (TCMT IO) (a -> b)
-> NamesT (TCMT IO) a -> NamesT (TCMT IO) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> NamesT (TCMT IO) Term
Var (TCMT IO)
j
           (Dom Type -> Type)
-> NamesT (TCMT IO) (Dom Type) -> NamesT (TCMT IO) Type
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 Dom Type -> Type
forall t e. Dom' t e -> e
unDom (NamesT (TCMT IO) (Dom Type) -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) (Dom Type) -> NamesT (TCMT IO) Type
forall a b. (a -> b) -> a -> b
$ 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]
[NamesT (TCMT IO) (SubstArg (Dom Type))]
args
      let face :: NamesT (TCMT IO) Term
face = 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
othersys <- (Term -> NamesT (TCMT IO) (NamesT (TCMT IO) Term)
forall (m :: * -> *) a.
(MonadFail m, Subst a) =>
a -> NamesT m (NamesT m a)
open (Term -> NamesT (TCMT IO) (NamesT (TCMT IO) Term))
-> NamesT (TCMT IO) Term
-> NamesT (TCMT IO) (NamesT (TCMT IO) Term)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (NamesT (TCMT IO) Term -> NamesT (TCMT IO) (NamesT (TCMT IO) Term))
-> NamesT (TCMT IO) Term
-> NamesT (TCMT IO) (NamesT (TCMT IO) Term)
forall a b. (a -> b) -> a -> b
$ String
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
lam String
"j" ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
 -> NamesT (TCMT IO) Term)
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall a b. (a -> b) -> a -> b
$ \ NamesT (TCMT IO) Term
j -> String
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
ilam String
"o" ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
 -> NamesT (TCMT IO) Term)
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall a b. (a -> b) -> a -> b
$ \ NamesT (TCMT IO) Term
_ -> do
        [NamesT (TCMT IO) Term]
args' <- ((Term -> NamesT (TCMT IO) (NamesT (TCMT IO) Term))
-> [Term] -> NamesT (TCMT IO) [NamesT (TCMT IO) Term]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Term -> NamesT (TCMT IO) (NamesT (TCMT IO) Term)
forall (m :: * -> *) a.
(MonadFail m, Subst a) =>
a -> NamesT m (NamesT m a)
open ([Term] -> NamesT (TCMT IO) [NamesT (TCMT IO) Term])
-> NamesT (TCMT IO) [Term]
-> NamesT (TCMT IO) [NamesT (TCMT IO) Term]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (NamesT (TCMT IO) [Term]
 -> NamesT (TCMT IO) [NamesT (TCMT IO) Term])
-> NamesT (TCMT IO) [Term]
-> NamesT (TCMT IO) [NamesT (TCMT IO) Term]
forall a b. (a -> b) -> a -> b
$ Abs [Term] -> Term -> [Term]
Abs [Term] -> SubstArg [Term] -> [Term]
forall a. Subst a => Abs a -> SubstArg a -> a
absApp (Abs [Term] -> Term -> [Term])
-> NamesT (TCMT IO) (Abs [Term])
-> NamesT (TCMT IO) (Term -> [Term])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamesT (TCMT IO) (Abs [Term])
args NamesT (TCMT IO) (Term -> [Term])
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) [Term]
forall a b.
NamesT (TCMT IO) (a -> b)
-> NamesT (TCMT IO) a -> NamesT (TCMT IO) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> NamesT (TCMT IO) Term
j
        ([Elim] -> Term)
-> NamesT (TCMT IO) [Elim] -> 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 (QName -> [Elim] -> Term
Def QName
f) (NamesT (TCMT IO) [Elim] -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) [Elim] -> NamesT (TCMT IO) Term
forall a b. (a -> b) -> a -> b
$ (([NamedArg DeBruijnPattern] -> [Elim])
-> AbsN [NamedArg DeBruijnPattern] -> AbsN [Elim]
forall a b. (a -> b) -> AbsN a -> AbsN b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [NamedArg DeBruijnPattern] -> [Elim]
patternsToElims (AbsN [NamedArg DeBruijnPattern] -> AbsN [Elim])
-> NamesT (TCMT IO) (AbsN [NamedArg DeBruijnPattern])
-> NamesT (TCMT IO) (AbsN [Elim])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamesT (TCMT IO) (AbsN [NamedArg DeBruijnPattern])
old_ps) NamesT (TCMT IO) (AbsN [Elim])
-> [NamesT (TCMT IO) (SubstArg [Elim])] -> NamesT (TCMT IO) [Elim]
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 [Elim])]
args'
      [(NamesT (TCMT IO) Term, NamesT (TCMT IO) Term)]
sys <- NamesT (TCMT IO) (Abs [Term])
-> NamesT
     (TCMT IO) [(NamesT (TCMT IO) Term, NamesT (TCMT IO) Term)]
mkBndry NamesT (TCMT IO) (Abs [Term])
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
sysphi = NamesT (TCMT IO) Term
othersys
        syspsi :: NamesT (TCMT IO) Term
syspsi = NamesT (TCMT IO) Term
othersys
      NamesT (TCMT IO) Term
base <- (Term -> NamesT (TCMT IO) (NamesT (TCMT IO) Term)
forall (m :: * -> *) a.
(MonadFail m, Subst a) =>
a -> NamesT m (NamesT m a)
open (Term -> NamesT (TCMT IO) (NamesT (TCMT IO) Term))
-> NamesT (TCMT IO) Term
-> NamesT (TCMT IO) (NamesT (TCMT IO) Term)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (NamesT (TCMT IO) Term -> NamesT (TCMT IO) (NamesT (TCMT IO) Term))
-> NamesT (TCMT IO) Term
-> NamesT (TCMT IO) (NamesT (TCMT IO) Term)
forall a b. (a -> b) -> a -> b
$ do
        [NamesT (TCMT IO) Term]
args' <- ((Term -> NamesT (TCMT IO) (NamesT (TCMT IO) Term))
-> [Term] -> NamesT (TCMT IO) [NamesT (TCMT IO) Term]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Term -> NamesT (TCMT IO) (NamesT (TCMT IO) Term)
forall (m :: * -> *) a.
(MonadFail m, Subst a) =>
a -> NamesT m (NamesT m a)
open ([Term] -> NamesT (TCMT IO) [NamesT (TCMT IO) Term])
-> NamesT (TCMT IO) [Term]
-> NamesT (TCMT IO) [NamesT (TCMT IO) Term]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (NamesT (TCMT IO) [Term]
 -> NamesT (TCMT IO) [NamesT (TCMT IO) Term])
-> NamesT (TCMT IO) [Term]
-> NamesT (TCMT IO) [NamesT (TCMT IO) Term]
forall a b. (a -> b) -> a -> b
$ Abs [Term] -> Term -> [Term]
Abs [Term] -> SubstArg [Term] -> [Term]
forall a. Subst a => Abs a -> SubstArg a -> a
absApp (Abs [Term] -> Term -> [Term])
-> NamesT (TCMT IO) (Abs [Term])
-> NamesT (TCMT IO) (Term -> [Term])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamesT (TCMT IO) (Abs [Term])
args NamesT (TCMT IO) (Term -> [Term])
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) [Term]
forall a b.
NamesT (TCMT IO) (a -> b)
-> NamesT (TCMT IO) a -> NamesT (TCMT IO) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Term -> NamesT (TCMT IO) Term
forall a. a -> NamesT (TCMT IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
iz
        ([Elim] -> Term)
-> NamesT (TCMT IO) [Elim] -> 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 (QName -> [Elim] -> Term
Def QName
f) (NamesT (TCMT IO) [Elim] -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) [Elim] -> NamesT (TCMT IO) Term
forall a b. (a -> b) -> a -> b
$ (([NamedArg DeBruijnPattern] -> [Elim])
-> AbsN [NamedArg DeBruijnPattern] -> AbsN [Elim]
forall a b. (a -> b) -> AbsN a -> AbsN b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [NamedArg DeBruijnPattern] -> [Elim]
patternsToElims (AbsN [NamedArg DeBruijnPattern] -> AbsN [Elim])
-> NamesT (TCMT IO) (AbsN [NamedArg DeBruijnPattern])
-> NamesT (TCMT IO) (AbsN [Elim])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamesT (TCMT IO) (AbsN [NamedArg DeBruijnPattern])
old_ps) NamesT (TCMT IO) (AbsN [Elim])
-> [NamesT (TCMT IO) (SubstArg [Elim])] -> NamesT (TCMT IO) [Elim]
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 [Elim])]
args'
      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
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)(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, NamesT (TCMT IO) Term)]
sys) NamesT (TCMT IO) Term
face NamesT (TCMT IO) Term
base
    (,,) ([NamedArg DeBruijnPattern]
 -> Dom Type
 -> Term
 -> ([NamedArg DeBruijnPattern], Dom Type, Term))
-> NamesT (TCMT IO) [NamedArg DeBruijnPattern]
-> NamesT
     (TCMT IO)
     (Dom Type -> Term -> ([NamedArg DeBruijnPattern], Dom Type, Term))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamesT (TCMT IO) [NamedArg DeBruijnPattern]
ps NamesT
  (TCMT IO)
  (Dom Type -> Term -> ([NamedArg DeBruijnPattern], Dom Type, Term))
-> NamesT (TCMT IO) (Dom Type)
-> NamesT
     (TCMT IO) (Term -> ([NamedArg DeBruijnPattern], Dom Type, Term))
forall a b.
NamesT (TCMT IO) (a -> b)
-> NamesT (TCMT IO) a -> NamesT (TCMT IO) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> NamesT (TCMT IO) (Dom Type)
rhsTy NamesT
  (TCMT IO) (Term -> ([NamedArg DeBruijnPattern], Dom Type, Term))
-> NamesT (TCMT IO) Term
-> NamesT (TCMT IO) ([NamedArg DeBruijnPattern], Dom Type, Term)
forall a b.
NamesT (TCMT IO) (a -> b)
-> NamesT (TCMT IO) a -> NamesT (TCMT IO) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Term -> NamesT (TCMT IO) Term
forall a. a -> NamesT (TCMT IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
rhs
  let ([NamedArg DeBruijnPattern]
ps,Dom Type
ty,Term
rhs) = AbsN ([NamedArg DeBruijnPattern], Dom Type, Term)
-> ([NamedArg DeBruijnPattern], Dom Type, Term)
forall a. AbsN a -> a
unAbsN (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term)
 -> ([NamedArg DeBruijnPattern], Dom Type, Term))
-> AbsN ([NamedArg DeBruijnPattern], Dom Type, Term)
-> ([NamedArg DeBruijnPattern], Dom Type, Term)
forall a b. (a -> b) -> a -> b
$ Abs (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term))
-> AbsN ([NamedArg DeBruijnPattern], Dom Type, Term)
forall a. Abs a -> a
unAbs (Abs (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term))
 -> AbsN ([NamedArg DeBruijnPattern], Dom Type, Term))
-> Abs (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term))
-> AbsN ([NamedArg DeBruijnPattern], Dom Type, Term)
forall a b. (a -> b) -> a -> b
$ Abs (Abs (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term)))
-> Abs (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term))
forall a. Abs a -> a
unAbs (Abs (Abs (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term)))
 -> Abs (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term)))
-> Abs (Abs (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term)))
-> Abs (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term))
forall a b. (a -> b) -> a -> b
$ Abs (Abs (Abs (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term))))
-> Abs (Abs (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term)))
forall a. Abs a -> a
unAbs (Abs
   (Abs (Abs (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term))))
 -> Abs (Abs (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term))))
-> Abs
     (Abs (Abs (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term))))
-> Abs (Abs (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term)))
forall a b. (a -> b) -> a -> b
$ AbsN
  (Abs
     (Abs (Abs (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term)))))
-> Abs
     (Abs (Abs (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term))))
forall a. AbsN a -> a
unAbsN (AbsN
   (Abs
      (Abs (Abs (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term)))))
 -> Abs
      (Abs (Abs (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term)))))
-> AbsN
     (Abs
        (Abs (Abs (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term)))))
-> Abs
     (Abs (Abs (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term))))
forall a b. (a -> b) -> a -> b
$ Abs
  (AbsN
     (Abs
        (Abs (Abs (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term))))))
-> AbsN
     (Abs
        (Abs (Abs (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term)))))
forall a. Abs a -> a
unAbs (Abs
   (AbsN
      (Abs
         (Abs (Abs (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term))))))
 -> AbsN
      (Abs
         (Abs (Abs (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term))))))
-> Abs
     (AbsN
        (Abs
           (Abs (Abs (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term))))))
-> AbsN
     (Abs
        (Abs (Abs (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term)))))
forall a b. (a -> b) -> a -> b
$ AbsN
  (Abs
     (AbsN
        (Abs
           (Abs (Abs (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term)))))))
-> Abs
     (AbsN
        (Abs
           (Abs (Abs (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term))))))
forall a. AbsN a -> a
unAbsN (AbsN
   (Abs
      (AbsN
         (Abs
            (Abs (Abs (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term)))))))
 -> Abs
      (AbsN
         (Abs
            (Abs (Abs (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term)))))))
-> AbsN
     (Abs
        (AbsN
           (Abs
              (Abs (Abs (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term)))))))
-> Abs
     (AbsN
        (Abs
           (Abs (Abs (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term))))))
forall a b. (a -> b) -> a -> b
$ AbsN
  (Abs
     (AbsN
        (Abs
           (Abs (Abs (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term)))))))
ps_ty_rhs
  String -> Int -> TCMT IO Doc -> TCMT IO ()
forall (m :: * -> *).
MonadDebug m =>
String -> Int -> TCMT IO Doc -> m ()
reportSDoc String
"tc.cover.trx.hcomp" Int
20 (TCMT IO Doc -> TCMT IO ()) -> TCMT IO Doc -> TCMT IO ()
forall a b. (a -> b) -> a -> b
$ TCMT IO Doc
"trX-hcomp clause for" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> QName -> TCMT IO Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
forall (m :: * -> *). MonadPretty m => QName -> m Doc
prettyTCM QName
f
  let c :: Clause
c = Clause { clauseLHSRange :: Range
clauseLHSRange  = Range
forall a. Range' a
noRange
                 , clauseFullRange :: Range
clauseFullRange = Range
forall a. Range' a
noRange
                 , clauseTel :: Telescope
clauseTel       = Telescope
cTel
                 , namedClausePats :: [NamedArg DeBruijnPattern]
namedClausePats = [NamedArg DeBruijnPattern]
ps
                 , clauseBody :: Maybe Term
clauseBody      = Term -> Maybe Term
forall a. a -> Maybe a
Just Term
rhs
                 , clauseType :: Maybe (Arg Type)
clauseType      = Arg Type -> Maybe (Arg Type)
forall a. a -> Maybe a
Just (Arg Type -> Maybe (Arg Type)) -> Arg Type -> Maybe (Arg Type)
forall a b. (a -> b) -> a -> b
$ ArgInfo -> Type -> Arg Type
forall e. ArgInfo -> e -> Arg e
Arg (Dom Type -> ArgInfo
forall a. LensArgInfo a => a -> ArgInfo
getArgInfo Dom Type
ty) (Dom Type -> Type
forall t e. Dom' t e -> e
unDom Dom Type
ty)
                 , clauseCatchall :: Bool
clauseCatchall    = Bool
False
                 , clauseExact :: Maybe Bool
clauseExact       = Maybe Bool
forall a. Maybe a
Nothing
                 , clauseRecursive :: Maybe Bool
clauseRecursive   = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True
                 , clauseUnreachable :: Maybe Bool
clauseUnreachable = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False
                 , clauseEllipsis :: ExpandedEllipsis
clauseEllipsis    = ExpandedEllipsis
NoEllipsis
                 , clauseWhereModule :: Maybe ModuleName
clauseWhereModule = Maybe ModuleName
forall a. Maybe a
Nothing
                 }
  String -> Clause -> TCMT IO ()
debugClause String
"tc.cover.trx.hcomp" Clause
c
  Clause -> TCM Clause
forall a. a -> TCMT IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Clause
c
createMissingTrXConClause :: QName -- trX
                            -> QName -- f defined
                            -> Arg Nat
                            -> BlockingVar
                            -> SplitClause
                            -> QName -- constructor name
                            -> UnifyEquiv
                            -> TCM Clause
createMissingTrXConClause :: QName
-> QName
-> Arg Int
-> BlockingVar
-> SplitClause
-> QName
-> UnifyEquiv
-> TCM Clause
createMissingTrXConClause QName
q_trX QName
f Arg Int
n BlockingVar
x SplitClause
old_sc QName
c (UE Telescope
gamma Telescope
gamma' Telescope
xTel [Term]
u [Term]
v PatternSubstitution
rho Substitution' Term
tau Substitution' Term
leftInv) = do
  String -> Int -> TCMT IO Doc -> TCMT IO ()
forall (m :: * -> *).
MonadDebug m =>
String -> Int -> TCMT IO Doc -> m ()
reportSDoc String
"tc.cover.trxcon" Int
20 (TCMT IO Doc -> TCMT IO ()) -> TCMT IO Doc -> TCMT IO ()
forall a b. (a -> b) -> a -> b
$ TCMT IO Doc
"trX-con clause for" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> QName -> TCMT IO Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
forall (m :: * -> *). MonadPretty m => QName -> m Doc
prettyTCM QName
f TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> TCMT IO Doc
"with con" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> QName -> TCMT IO Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
forall (m :: * -> *). MonadPretty m => QName -> m Doc
prettyTCM QName
c
  String -> Int -> TCMT IO Doc -> TCMT IO ()
forall (m :: * -> *).
MonadDebug m =>
String -> Int -> TCMT IO Doc -> m ()
reportSDoc String
"tc.cover.trxcon" Int
20 (TCMT IO Doc -> TCMT IO ()) -> TCMT IO Doc -> TCMT IO ()
forall a b. (a -> b) -> a -> b
$ Int -> TCMT IO Doc -> TCMT IO Doc
forall (m :: * -> *). Functor m => Int -> m Doc -> m Doc
nest Int
2 (TCMT IO Doc -> TCMT IO Doc) -> TCMT IO Doc -> TCMT IO Doc
forall a b. (a -> b) -> a -> b
$ [TCMT IO Doc] -> TCMT IO Doc
forall (m :: * -> *) (t :: * -> *).
(Applicative m, Foldable t) =>
t (m Doc) -> m Doc
vcat ([TCMT IO Doc] -> TCMT IO Doc) -> [TCMT IO Doc] -> TCMT IO Doc
forall a b. (a -> b) -> a -> b
$
    [ TCMT IO Doc
"gamma" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> Telescope -> TCMT IO Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
forall (m :: * -> *). MonadPretty m => Telescope -> m Doc
prettyTCM Telescope
gamma
    , TCMT IO Doc
"gamma'" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> Telescope -> TCMT IO Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
forall (m :: * -> *). MonadPretty m => Telescope -> m Doc
prettyTCM Telescope
gamma'
    , TCMT IO Doc
"xTel" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> Telescope -> TCMT IO Doc -> TCMT IO Doc
forall b (m :: * -> *) a.
(AddContext b, MonadAddContext m) =>
b -> m a -> m a
forall (m :: * -> *) a.
MonadAddContext m =>
Telescope -> m a -> m a
addContext Telescope
gamma (Telescope -> TCMT IO Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
forall (m :: * -> *). MonadPretty m => Telescope -> m Doc
prettyTCM Telescope
xTel)
    , TCMT IO Doc
"u"  TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> Telescope -> TCMT IO Doc -> TCMT IO Doc
forall b (m :: * -> *) a.
(AddContext b, MonadAddContext m) =>
b -> m a -> m a
forall (m :: * -> *) a.
MonadAddContext m =>
Telescope -> m a -> m a
addContext Telescope
gamma ([Term] -> TCMT IO Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
forall (m :: * -> *). MonadPretty m => [Term] -> m Doc
prettyTCM [Term]
u)
    , TCMT IO Doc
"v"  TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> Telescope -> TCMT IO Doc -> TCMT IO Doc
forall b (m :: * -> *) a.
(AddContext b, MonadAddContext m) =>
b -> m a -> m a
forall (m :: * -> *) a.
MonadAddContext m =>
Telescope -> m a -> m a
addContext Telescope
gamma ([Term] -> TCMT IO Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
forall (m :: * -> *). MonadPretty m => [Term] -> m Doc
prettyTCM [Term]
v)
    , TCMT IO Doc
"rho" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> Telescope -> TCMT IO Doc -> TCMT IO Doc
forall b (m :: * -> *) a.
(AddContext b, MonadAddContext m) =>
b -> m a -> m a
forall (m :: * -> *) a.
MonadAddContext m =>
Telescope -> m a -> m a
addContext Telescope
gamma' (PatternSubstitution -> TCMT IO Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
forall (m :: * -> *). MonadPretty m => PatternSubstitution -> m Doc
prettyTCM PatternSubstitution
rho)
    ]

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

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

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

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

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

  -- Γ' ⊢ ρ : Γ

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

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

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

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

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

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

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

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

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

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

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

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

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


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

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

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

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

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


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

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

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

  Term
iz <- TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primIZero
  Type
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
  let
      old_tel :: Telescope
old_tel = SplitClause -> Telescope
scTel SplitClause
old_sc
      old_ps :: NamesT (TCMT IO) (AbsN [NamedArg DeBruijnPattern])
old_ps = AbsN [NamedArg DeBruijnPattern]
-> NamesT (TCMT IO) (AbsN [NamedArg DeBruijnPattern])
forall a. a -> NamesT (TCMT IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AbsN [NamedArg DeBruijnPattern]
 -> NamesT (TCMT IO) (AbsN [NamedArg DeBruijnPattern]))
-> AbsN [NamedArg DeBruijnPattern]
-> NamesT (TCMT IO) (AbsN [NamedArg DeBruijnPattern])
forall a b. (a -> b) -> a -> b
$ [String]
-> [NamedArg DeBruijnPattern] -> AbsN [NamedArg DeBruijnPattern]
forall a. [String] -> a -> AbsN a
AbsN (Telescope -> [String]
teleNames Telescope
old_tel) ([NamedArg DeBruijnPattern] -> AbsN [NamedArg DeBruijnPattern])
-> [NamedArg DeBruijnPattern] -> AbsN [NamedArg DeBruijnPattern]
forall a b. (a -> b) -> a -> b
$ [NamedArg SplitPattern] -> [NamedArg DeBruijnPattern]
fromSplitPatterns ([NamedArg SplitPattern] -> [NamedArg DeBruijnPattern])
-> [NamedArg SplitPattern] -> [NamedArg DeBruijnPattern]
forall a b. (a -> b) -> a -> b
$ SplitClause -> [NamedArg SplitPattern]
scPats SplitClause
old_sc
      old_ty :: NamesT (TCMT IO) (AbsN (Dom Type))
old_ty = AbsN (Dom Type) -> NamesT (TCMT IO) (AbsN (Dom Type))
forall a. a -> NamesT (TCMT IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AbsN (Dom Type) -> NamesT (TCMT IO) (AbsN (Dom Type)))
-> AbsN (Dom Type) -> NamesT (TCMT IO) (AbsN (Dom Type))
forall a b. (a -> b) -> a -> b
$ [String] -> Dom Type -> AbsN (Dom Type)
forall a. [String] -> a -> AbsN a
AbsN (Telescope -> [String]
teleNames Telescope
old_tel) (Dom Type -> AbsN (Dom Type)) -> Dom Type -> AbsN (Dom Type)
forall a b. (a -> b) -> a -> b
$ Dom Type -> Maybe (Dom Type) -> Dom Type
forall a. a -> Maybe a -> a
fromMaybe Dom Type
forall a. HasCallStack => a
__IMPOSSIBLE__ (Maybe (Dom Type) -> Dom Type) -> Maybe (Dom Type) -> Dom Type
forall a b. (a -> b) -> a -> b
$ SplitClause -> Maybe (Dom Type)
scTarget SplitClause
old_sc
  -- old_tel = Γ(x: D η v)Δ
  -- Γ1, (x : D η v)  ⊢ delta = (δ : Δ)
      (Telescope
gamma1x,Telescope
delta') = Int -> Telescope -> (Telescope, Telescope)
splitTelescopeAt (Telescope -> Int
forall a. Sized a => a -> Int
size Telescope
old_tel Int -> Int -> Int
forall a. Num a => a -> a -> a
- BlockingVar -> Int
blockingVarNo BlockingVar
x) Telescope
old_tel
  let
    gammaArgNames :: [Arg String]
gammaArgNames = Telescope -> [Arg String]
teleArgNames Telescope
gamma
    deltaArgNames :: [Arg String]
deltaArgNames = Telescope -> [Arg String]
teleArgNames Telescope
delta'
  let
    xTelI :: NamesT (TCMT IO) (AbsN Telescope)
xTelI = AbsN Telescope -> NamesT (TCMT IO) (AbsN Telescope)
forall a. a -> NamesT (TCMT IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AbsN Telescope -> NamesT (TCMT IO) (AbsN Telescope))
-> AbsN Telescope -> NamesT (TCMT IO) (AbsN Telescope)
forall a b. (a -> b) -> a -> b
$ [String] -> Telescope -> AbsN Telescope
forall a. [String] -> a -> AbsN a
AbsN (Telescope -> [String]
teleNames Telescope
gamma) (Telescope -> AbsN Telescope) -> Telescope -> AbsN Telescope
forall a b. (a -> b) -> a -> b
$ Type -> Telescope -> Telescope
expTelescope Type
interval Telescope
xTel
    delta :: NamesT (TCMT IO) (AbsN Telescope)
delta = AbsN Telescope -> NamesT (TCMT IO) (AbsN Telescope)
forall a. a -> NamesT (TCMT IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AbsN Telescope -> NamesT (TCMT IO) (AbsN Telescope))
-> AbsN Telescope -> NamesT (TCMT IO) (AbsN Telescope)
forall a b. (a -> b) -> a -> b
$ [String] -> Telescope -> AbsN Telescope
forall a. [String] -> a -> AbsN a
AbsN (Telescope -> [String]
teleNames Telescope
gamma1x) (Telescope -> AbsN Telescope) -> Telescope -> AbsN Telescope
forall a b. (a -> b) -> a -> b
$ Telescope
delta'
    gamma1_size :: Int
gamma1_size = (Telescope -> Int
forall a. Sized a => a -> Int
size Telescope
gamma1x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
    (Telescope
gamma1,ExtendTel Dom Type
dType' Abs Telescope
_) = Int -> Telescope -> (Telescope, Telescope)
splitTelescopeAt Int
gamma1_size Telescope
gamma1x
  AbsN Args
params <- Telescope -> TCMT IO (AbsN Args) -> TCMT IO (AbsN Args)
forall b (m :: * -> *) a.
(AddContext b, MonadAddContext m) =>
b -> m a -> m a
forall (m :: * -> *) a.
MonadAddContext m =>
Telescope -> m a -> m a
addContext Telescope
gamma1 (TCMT IO (AbsN Args) -> TCMT IO (AbsN Args))
-> TCMT IO (AbsN Args) -> TCMT IO (AbsN Args)
forall a b. (a -> b) -> a -> b
$ do
    Just (QName
_d, Args
ps, Args
_is) <- Type -> TCMT IO (Maybe (QName, Args, Args))
forall (m :: * -> *).
HasConstInfo m =>
Type -> m (Maybe (QName, Args, Args))
getDatatypeArgs (Type -> TCMT IO (Maybe (QName, Args, Args)))
-> (Dom Type -> Type)
-> Dom Type
-> TCMT IO (Maybe (QName, Args, Args))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dom Type -> Type
forall t e. Dom' t e -> e
unDom (Dom Type -> TCMT IO (Maybe (QName, Args, Args)))
-> TCMT IO (Dom Type) -> TCMT IO (Maybe (QName, Args, Args))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Dom Type -> TCMT IO (Dom Type)
forall a (m :: * -> *). (Reduce a, MonadReduce m) => a -> m a
reduce Dom Type
dType'
    AbsN Args -> TCMT IO (AbsN Args)
forall a. a -> TCMT IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (AbsN Args -> TCMT IO (AbsN Args))
-> AbsN Args -> TCMT IO (AbsN Args)
forall a b. (a -> b) -> a -> b
$ [String] -> Args -> AbsN Args
forall a. [String] -> a -> AbsN a
AbsN (Telescope -> [String]
teleNames Telescope
gamma1) Args
ps
  -- Γ, φ , p ⊢ pat := trX p φ (c a)
  let pat' :: NamesT (TCMT IO) (AbsN (AbsN DeBruijnPattern))
pat' =
            [Arg String]
-> (ArgVars (TCMT IO) -> NamesT (TCMT IO) (AbsN DeBruijnPattern))
-> NamesT (TCMT IO) (AbsN (AbsN DeBruijnPattern))
forall (m :: * -> *) a.
MonadFail m =>
[Arg String] -> (ArgVars m -> NamesT m a) -> NamesT m (AbsN a)
bindNArg [Arg String]
gammaArgNames ((ArgVars (TCMT IO) -> NamesT (TCMT IO) (AbsN DeBruijnPattern))
 -> NamesT (TCMT IO) (AbsN (AbsN DeBruijnPattern)))
-> (ArgVars (TCMT IO) -> NamesT (TCMT IO) (AbsN DeBruijnPattern))
-> NamesT (TCMT IO) (AbsN (AbsN DeBruijnPattern))
forall a b. (a -> b) -> a -> b
$ \ ArgVars (TCMT IO)
g1_args -> do
            [Arg String]
-> (ArgVars (TCMT IO) -> NamesT (TCMT IO) DeBruijnPattern)
-> NamesT (TCMT IO) (AbsN DeBruijnPattern)
forall (m :: * -> *) a.
MonadFail m =>
[Arg String] -> (ArgVars m -> NamesT m a) -> NamesT m (AbsN a)
bindNArg ([String -> Arg String
forall e. e -> Arg e
defaultArg String
"phi"] [Arg String] -> [Arg String] -> [Arg String]
forall a. [a] -> [a] -> [a]
++ Telescope -> [Arg String]
teleArgNames Telescope
xTel) ((ArgVars (TCMT IO) -> NamesT (TCMT IO) DeBruijnPattern)
 -> NamesT (TCMT IO) (AbsN DeBruijnPattern))
-> (ArgVars (TCMT IO) -> NamesT (TCMT IO) DeBruijnPattern)
-> NamesT (TCMT IO) (AbsN DeBruijnPattern)
forall a b. (a -> b) -> a -> b
$ \ ArgVars (TCMT IO)
phi_p -> do
            let ([NamesT (TCMT IO) (NamedArg DeBruijnPattern)]
g1,[NamesT (TCMT IO) (NamedArg DeBruijnPattern)]
args) = Int
-> [NamesT (TCMT IO) (NamedArg DeBruijnPattern)]
-> ([NamesT (TCMT IO) (NamedArg DeBruijnPattern)],
    [NamesT (TCMT IO) (NamedArg DeBruijnPattern)])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
gamma1_size [NamesT (TCMT IO) (NamedArg DeBruijnPattern)]
ArgVars (TCMT IO)
g1_args
            (NamedArg DeBruijnPattern
phi:[NamedArg DeBruijnPattern]
p) <- [NamesT (TCMT IO) (NamedArg DeBruijnPattern)]
-> NamesT (TCMT IO) [NamedArg DeBruijnPattern]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence [NamesT (TCMT IO) (NamedArg DeBruijnPattern)]
ArgVars (TCMT IO)
phi_p
            [NamedArg DeBruijnPattern]
args <- [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)]
args
            let cargs :: NamedArg DeBruijnPattern
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.
            [NamedArg DeBruijnPattern]
param_args <- (Args -> [NamedArg DeBruijnPattern])
-> NamesT (TCMT IO) Args
-> NamesT (TCMT IO) [NamedArg DeBruijnPattern]
forall a b. (a -> b) -> NamesT (TCMT IO) a -> NamesT (TCMT IO) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Arg Term -> NamedArg DeBruijnPattern)
-> Args -> [NamedArg DeBruijnPattern]
forall a b. (a -> b) -> [a] -> [b]
map (Quantity -> NamedArg DeBruijnPattern -> NamedArg DeBruijnPattern
forall a. LensQuantity a => Quantity -> a -> a
setQuantity (Q0Origin -> Quantity
Quantity0 Q0Origin
Q0Inferred) (NamedArg DeBruijnPattern -> NamedArg DeBruijnPattern)
-> (Arg Term -> NamedArg DeBruijnPattern)
-> Arg Term
-> NamedArg DeBruijnPattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hiding -> NamedArg DeBruijnPattern -> NamedArg DeBruijnPattern
forall a. LensHiding a => Hiding -> a -> a
setHiding Hiding
Hidden (NamedArg DeBruijnPattern -> NamedArg DeBruijnPattern)
-> (Arg Term -> NamedArg DeBruijnPattern)
-> Arg Term
-> NamedArg DeBruijnPattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Term -> Named_ DeBruijnPattern)
-> Arg Term -> NamedArg DeBruijnPattern
forall a b. (a -> b) -> Arg a -> Arg b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (DeBruijnPattern -> Named_ DeBruijnPattern
forall a name. a -> Named name a
unnamed (DeBruijnPattern -> Named_ DeBruijnPattern)
-> (Term -> DeBruijnPattern) -> Term -> Named_ DeBruijnPattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term -> DeBruijnPattern
forall a. Term -> Pattern' a
dotP))) (NamesT (TCMT IO) Args
 -> NamesT (TCMT IO) [NamedArg DeBruijnPattern])
-> NamesT (TCMT IO) Args
-> NamesT (TCMT IO) [NamedArg DeBruijnPattern]
forall a b. (a -> b) -> a -> b
$
              AbsN Args -> NamesT (TCMT IO) (AbsN Args)
forall a. a -> NamesT (TCMT IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure AbsN Args
params NamesT (TCMT IO) (AbsN Args)
-> [NamesT (TCMT IO) (SubstArg Args)] -> NamesT (TCMT IO) Args
forall (m :: * -> *) a.
(Monad m, Subst a) =>
NamesT m (AbsN a) -> [NamesT m (SubstArg a)] -> NamesT m a
`applyN` Int -> [NamesT (TCMT IO) Term] -> [NamesT (TCMT IO) Term]
forall a. Int -> [a] -> [a]
take Int
gamma1_size ((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_args)
            DeBruijnPattern -> NamesT (TCMT IO) DeBruijnPattern
forall a. a -> NamesT (TCMT IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DeBruijnPattern -> NamesT (TCMT IO) DeBruijnPattern)
-> DeBruijnPattern -> NamesT (TCMT IO) DeBruijnPattern
forall a b. (a -> b) -> a -> b
$ PatternInfo
-> QName -> [NamedArg DeBruijnPattern] -> DeBruijnPattern
forall x.
PatternInfo -> QName -> [NamedArg (Pattern' x)] -> Pattern' x
DefP PatternInfo
defaultPatternInfo QName
q_trX ([NamedArg DeBruijnPattern] -> DeBruijnPattern)
-> [NamedArg DeBruijnPattern] -> DeBruijnPattern
forall a b. (a -> b) -> a -> b
$ [NamedArg DeBruijnPattern]
param_args [NamedArg DeBruijnPattern]
-> [NamedArg DeBruijnPattern] -> [NamedArg DeBruijnPattern]
forall a. [a] -> [a] -> [a]
++ [NamedArg DeBruijnPattern]
p [NamedArg DeBruijnPattern]
-> [NamedArg DeBruijnPattern] -> [NamedArg DeBruijnPattern]
forall a. [a] -> [a] -> [a]
++ [NamedArg DeBruijnPattern
phi,NamedArg DeBruijnPattern
cargs]
      pat :: NamesT (TCMT IO) (AbsN (AbsN Term))
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' :: NamesT (TCMT IO) (AbsN (AbsN (Abs Term)))
pat_left' = ((AbsN Term -> AbsN (Abs Term))
-> AbsN (AbsN Term) -> AbsN (AbsN (Abs Term))
forall a b. (a -> b) -> AbsN a -> AbsN b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((AbsN Term -> AbsN (Abs Term))
 -> AbsN (AbsN Term) -> AbsN (AbsN (Abs Term)))
-> ((Term -> Abs Term) -> AbsN Term -> AbsN (Abs Term))
-> (Term -> Abs Term)
-> AbsN (AbsN Term)
-> AbsN (AbsN (Abs Term))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Term -> Abs Term) -> AbsN Term -> AbsN (Abs Term)
forall a b. (a -> b) -> AbsN a -> AbsN b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) (String -> Term -> Abs Term
forall a. String -> a -> Abs a
Abs String
"i" (Term -> Abs Term) -> (Term -> Term) -> Term -> Abs Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Substitution' (SubstArg Term) -> Term -> Term
forall a. Subst a => Substitution' (SubstArg a) -> a -> a
applySubst Substitution' Term
Substitution' (SubstArg Term)
leftInv)) (AbsN (AbsN Term) -> AbsN (AbsN (Abs Term)))
-> NamesT (TCMT IO) (AbsN (AbsN Term))
-> NamesT (TCMT IO) (AbsN (AbsN (Abs Term)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamesT (TCMT IO) (AbsN (AbsN Term))
pat
      g1_left' :: NamesT (TCMT IO) (AbsN (AbsN (Abs [Term])))
g1_left' = [String]
-> (Vars (TCMT IO) -> NamesT (TCMT IO) (AbsN (Abs [Term])))
-> NamesT (TCMT IO) (AbsN (AbsN (Abs [Term])))
forall (m :: * -> *) a.
MonadFail m =>
[String] -> (Vars m -> NamesT m a) -> NamesT m (AbsN a)
bindN ((Arg String -> String) -> [Arg String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Arg String -> String
forall e. Arg e -> e
unArg [Arg String]
gammaArgNames) ((Vars (TCMT IO) -> NamesT (TCMT IO) (AbsN (Abs [Term])))
 -> NamesT (TCMT IO) (AbsN (AbsN (Abs [Term]))))
-> (Vars (TCMT IO) -> NamesT (TCMT IO) (AbsN (Abs [Term])))
-> NamesT (TCMT IO) (AbsN (AbsN (Abs [Term])))
forall a b. (a -> b) -> a -> b
$ \ Vars (TCMT IO)
g1_args -> do
                [String]
-> (Vars (TCMT IO) -> NamesT (TCMT IO) (Abs [Term]))
-> NamesT (TCMT IO) (AbsN (Abs [Term]))
forall (m :: * -> *) a.
MonadFail m =>
[String] -> (Vars m -> NamesT m a) -> NamesT m (AbsN a)
bindN ((Arg String -> String) -> [Arg String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Arg String -> String
forall e. Arg e -> e
unArg ([Arg String] -> [String]) -> [Arg String] -> [String]
forall a b. (a -> b) -> a -> b
$ [String -> Arg String
forall e. e -> Arg e
defaultArg String
"phi"] [Arg String] -> [Arg String] -> [Arg String]
forall a. [a] -> [a] -> [a]
++ Telescope -> [Arg String]
teleArgNames Telescope
xTel) ((Vars (TCMT IO) -> NamesT (TCMT IO) (Abs [Term]))
 -> NamesT (TCMT IO) (AbsN (Abs [Term])))
-> (Vars (TCMT IO) -> NamesT (TCMT IO) (Abs [Term]))
-> NamesT (TCMT IO) (AbsN (Abs [Term]))
forall a b. (a -> b) -> a -> b
$ \ Vars (TCMT IO)
phi_p -> do
                [Term]
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]
                Abs [Term] -> NamesT (TCMT IO) (Abs [Term])
forall a. a -> NamesT (TCMT IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Abs [Term] -> NamesT (TCMT IO) (Abs [Term]))
-> Abs [Term] -> NamesT (TCMT IO) (Abs [Term])
forall a b. (a -> b) -> a -> b
$ String -> [Term] -> Abs [Term]
forall a. String -> a -> Abs a
Abs String
"i" (Substitution' (SubstArg [Term]) -> [Term] -> [Term]
forall a. Subst a => Substitution' (SubstArg a) -> a -> a
applySubst Substitution' Term
Substitution' (SubstArg [Term])
leftInv [Term]
g1)

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

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

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

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

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

    --  trFillTel (i. Δ[γ1[leftInv (~ i)], pat[leftInv (~i)]]) φ δ
    NamesT (TCMT IO) (Abs [Term])
d_f <- (Abs [Term] -> NamesT (TCMT IO) (NamesT (TCMT IO) (Abs [Term]))
forall (m :: * -> *) a.
(MonadFail m, Subst a) =>
a -> NamesT m (NamesT m a)
open (Abs [Term] -> NamesT (TCMT IO) (NamesT (TCMT IO) (Abs [Term])))
-> NamesT (TCMT IO) (Abs [Term])
-> NamesT (TCMT IO) (NamesT (TCMT IO) (Abs [Term]))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (NamesT (TCMT IO) (Abs [Term])
 -> NamesT (TCMT IO) (NamesT (TCMT IO) (Abs [Term])))
-> NamesT (TCMT IO) (Abs [Term])
-> NamesT (TCMT IO) (NamesT (TCMT IO) (Abs [Term]))
forall a b. (a -> b) -> a -> b
$ String
-> (Var (TCMT IO) -> NamesT (TCMT IO) [Term])
-> NamesT (TCMT IO) (Abs [Term])
forall (m :: * -> *) a.
MonadFail m =>
String
-> ((forall b. (Subst b, DeBruijn b) => NamesT m b) -> NamesT m a)
-> NamesT m (Abs a)
bind String
"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
      Abs Telescope
delta_f <- NamesT (TCMT IO) (Abs Telescope)
delta_f
      Term
phi <- NamesT (TCMT IO) Term
Var (TCMT IO)
phi
      Args
d <- (Term -> Arg Term) -> [Term] -> Args
forall a b. (a -> b) -> [a] -> [b]
map Term -> Arg Term
forall e. e -> Arg e
defaultArg ([Term] -> Args)
-> NamesT (TCMT IO) [Term] -> NamesT (TCMT IO) Args
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [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)
d
      Term
i <- NamesT (TCMT IO) Term
Var (TCMT IO)
i
      TCM [Term] -> NamesT (TCMT IO) [Term]
forall (m :: * -> *) a. Monad m => m a -> NamesT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (TCM [Term] -> NamesT (TCMT IO) [Term])
-> TCM [Term] -> NamesT (TCMT IO) [Term]
forall a b. (a -> b) -> a -> b
$ QName -> Abs Telescope -> Term -> Args -> Term -> TCM [Term]
covFillTele QName
f Abs Telescope
delta_f Term
phi Args
d Term
i

    -- w = Def f (old_ps[g1_left[i],pat_left[i],d_f[~ i]])
    NamesT (TCMT IO) (Abs Term)
w <- (Abs Term -> NamesT (TCMT IO) (NamesT (TCMT IO) (Abs Term))
forall (m :: * -> *) a.
(MonadFail m, Subst a) =>
a -> NamesT m (NamesT m a)
open (Abs Term -> NamesT (TCMT IO) (NamesT (TCMT IO) (Abs Term)))
-> NamesT (TCMT IO) (Abs Term)
-> NamesT (TCMT IO) (NamesT (TCMT IO) (Abs Term))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (NamesT (TCMT IO) (Abs Term)
 -> NamesT (TCMT IO) (NamesT (TCMT IO) (Abs Term)))
-> NamesT (TCMT IO) (Abs Term)
-> NamesT (TCMT IO) (NamesT (TCMT IO) (Abs Term))
forall a b. (a -> b) -> a -> b
$ String
-> (Var (TCMT IO) -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) (Abs Term)
forall (m :: * -> *) a.
MonadFail m =>
String
-> ((forall b. (Subst b, DeBruijn b) => NamesT m b) -> NamesT m a)
-> NamesT m (Abs a)
bind String
"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
      [NamesT (TCMT IO) Term]
psargs <- ((Term -> NamesT (TCMT IO) (NamesT (TCMT IO) Term))
-> [Term] -> NamesT (TCMT IO) [NamesT (TCMT IO) Term]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Term -> NamesT (TCMT IO) (NamesT (TCMT IO) Term)
forall (m :: * -> *) a.
(MonadFail m, Subst a) =>
a -> NamesT m (NamesT m a)
open ([Term] -> NamesT (TCMT IO) [NamesT (TCMT IO) Term])
-> NamesT (TCMT IO) [Term]
-> NamesT (TCMT IO) [NamesT (TCMT IO) Term]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (NamesT (TCMT IO) [Term]
 -> NamesT (TCMT IO) [NamesT (TCMT IO) Term])
-> NamesT (TCMT IO) [Term]
-> NamesT (TCMT IO) [NamesT (TCMT IO) Term]
forall a b. (a -> b) -> a -> b
$ do
        [Term]
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
        Term
y <- 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_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
        [Term]
zs <- 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])
d_f NamesT (TCMT IO) (Term -> [Term])
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) [Term]
forall a b.
NamesT (TCMT IO) (a -> b)
-> NamesT (TCMT IO) a -> NamesT (TCMT IO) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> NamesT (TCMT IO) Term -> 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
        [Term] -> NamesT (TCMT IO) [Term]
forall a. a -> NamesT (TCMT IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Term] -> NamesT (TCMT IO) [Term])
-> [Term] -> NamesT (TCMT IO) [Term]
forall a b. (a -> b) -> a -> b
$ [Term]
xs [Term] -> [Term] -> [Term]
forall a. [a] -> [a] -> [a]
++ [Term
y] [Term] -> [Term] -> [Term]
forall a. [a] -> [a] -> [a]
++ [Term]
zs
      [Elim]
ps <- (([NamedArg DeBruijnPattern] -> [Elim])
-> AbsN [NamedArg DeBruijnPattern] -> AbsN [Elim]
forall a b. (a -> b) -> AbsN a -> AbsN b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [NamedArg DeBruijnPattern] -> [Elim]
patternsToElims (AbsN [NamedArg DeBruijnPattern] -> AbsN [Elim])
-> NamesT (TCMT IO) (AbsN [NamedArg DeBruijnPattern])
-> NamesT (TCMT IO) (AbsN [Elim])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamesT (TCMT IO) (AbsN [NamedArg DeBruijnPattern])
old_ps) NamesT (TCMT IO) (AbsN [Elim])
-> [NamesT (TCMT IO) (SubstArg [Elim])] -> NamesT (TCMT IO) [Elim]
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 [Elim])]
psargs
      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
$ QName -> [Elim] -> Term
Def QName
f [Elim]
ps


    -- (i. old_t[γ1[leftInv i],x = pat[leftInv i], δ_f[~i]])
    NamesT (TCMT IO) (Abs Type)
ty <- (Abs Type -> NamesT (TCMT IO) (NamesT (TCMT IO) (Abs Type))
forall (m :: * -> *) a.
(MonadFail m, Subst a) =>
a -> NamesT m (NamesT m a)
open (Abs Type -> NamesT (TCMT IO) (NamesT (TCMT IO) (Abs Type)))
-> NamesT (TCMT IO) (Abs Type)
-> NamesT (TCMT IO) (NamesT (TCMT IO) (Abs Type))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (NamesT (TCMT IO) (Abs Type)
 -> NamesT (TCMT IO) (NamesT (TCMT IO) (Abs Type)))
-> NamesT (TCMT IO) (Abs Type)
-> NamesT (TCMT IO) (NamesT (TCMT IO) (Abs Type))
forall a b. (a -> b) -> a -> b
$ String
-> (Var (TCMT IO) -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) (Abs Type)
forall (m :: * -> *) a.
MonadFail m =>
String
-> ((forall b. (Subst b, DeBruijn b) => NamesT m b) -> NamesT m a)
-> NamesT m (Abs a)
bind String
"i" ((Var (TCMT IO) -> NamesT (TCMT IO) Type)
 -> NamesT (TCMT IO) (Abs Type))
-> (Var (TCMT IO) -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) (Abs Type)
forall a b. (a -> b) -> a -> b
$ \ Var (TCMT IO)
i -> do
      [NamesT (TCMT IO) Term]
tyargs <- ((Term -> NamesT (TCMT IO) (NamesT (TCMT IO) Term))
-> [Term] -> NamesT (TCMT IO) [NamesT (TCMT IO) Term]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Term -> NamesT (TCMT IO) (NamesT (TCMT IO) Term)
forall (m :: * -> *) a.
(MonadFail m, Subst a) =>
a -> NamesT m (NamesT m a)
open ([Term] -> NamesT (TCMT IO) [NamesT (TCMT IO) Term])
-> NamesT (TCMT IO) [Term]
-> NamesT (TCMT IO) [NamesT (TCMT IO) Term]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (NamesT (TCMT IO) [Term]
 -> NamesT (TCMT IO) [NamesT (TCMT IO) Term])
-> NamesT (TCMT IO) [Term]
-> NamesT (TCMT IO) [NamesT (TCMT IO) Term]
forall a b. (a -> b) -> a -> b
$ do
        [Term]
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
        Term
y <- 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_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
        [Term]
zs <- 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])
d_f NamesT (TCMT IO) (Term -> [Term])
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) [Term]
forall a b.
NamesT (TCMT IO) (a -> b)
-> NamesT (TCMT IO) a -> NamesT (TCMT IO) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> NamesT (TCMT IO) Term -> 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
        [Term] -> NamesT (TCMT IO) [Term]
forall a. a -> NamesT (TCMT IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Term] -> NamesT (TCMT IO) [Term])
-> [Term] -> NamesT (TCMT IO) [Term]
forall a b. (a -> b) -> a -> b
$ [Term]
xs [Term] -> [Term] -> [Term]
forall a. [a] -> [a] -> [a]
++ [Term
y] [Term] -> [Term] -> [Term]
forall a. [a] -> [a] -> [a]
++ [Term]
zs
      (Dom Type -> Type)
-> NamesT (TCMT IO) (Dom Type) -> NamesT (TCMT IO) Type
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 Dom Type -> Type
forall t e. Dom' t e -> e
unDom (NamesT (TCMT IO) (Dom Type) -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) (Dom Type) -> NamesT (TCMT IO) Type
forall a b. (a -> b) -> a -> b
$ 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]
[NamesT (TCMT IO) (SubstArg (Dom Type))]
tyargs

    [(NamesT (TCMT IO) Term, NamesT (TCMT IO) Term)]
sys <- do
      [(Term, Abs Term)]
sides <- do
        Term
neg <- NamesT (TCMT IO) Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primINeg
        Term
io <- NamesT (TCMT IO) Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primIOne
        [Int]
vs <- [NamedArg DeBruijnPattern] -> [Int]
forall p. IApplyVars p => p -> [Int]
iApplyVars ([NamedArg DeBruijnPattern] -> [Int])
-> NamesT (TCMT IO) [NamedArg DeBruijnPattern]
-> NamesT (TCMT IO) [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamesT (TCMT IO) [NamedArg DeBruijnPattern]
ps
        Abs Term
tm <- NamesT (TCMT IO) (Abs Term)
w
        [(Term, (Abs Term, Abs Term))]
xs <- [Int]
-> (Int -> NamesT (TCMT IO) (Term, (Abs Term, Abs Term)))
-> NamesT (TCMT IO) [(Term, (Abs Term, Abs Term))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Int]
vs ((Int -> NamesT (TCMT IO) (Term, (Abs Term, Abs Term)))
 -> NamesT (TCMT IO) [(Term, (Abs Term, Abs Term))])
-> (Int -> NamesT (TCMT IO) (Term, (Abs Term, Abs Term)))
-> NamesT (TCMT IO) [(Term, (Abs Term, Abs Term))]
forall a b. (a -> b) -> a -> b
$ \ 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)
        [(Term, Abs Term)] -> NamesT (TCMT IO) [(Term, Abs Term)]
forall a. a -> NamesT (TCMT IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Term, Abs Term)] -> NamesT (TCMT IO) [(Term, Abs Term)])
-> [(Term, Abs Term)] -> NamesT (TCMT IO) [(Term, Abs Term)]
forall a b. (a -> b) -> a -> b
$ ((Term, (Abs Term, Abs Term)) -> [(Term, Abs Term)])
-> [(Term, (Abs Term, Abs Term))] -> [(Term, Abs Term)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(Term
v,(Abs Term
l,Abs Term
r)) -> [(Term
neg Term -> Args -> Term
forall t. Apply t => t -> Args -> t
`apply` [Term -> Arg Term
forall e. e -> Arg e
argN Term
v],Abs Term
l),(Term
v,Abs Term
r)]) [(Term, (Abs Term, Abs Term))]
xs
      [(Term, Abs Term)]
-> ((Term, Abs Term)
    -> NamesT (TCMT IO) (NamesT (TCMT IO) Term, NamesT (TCMT IO) Term))
-> NamesT
     (TCMT IO) [(NamesT (TCMT IO) Term, NamesT (TCMT IO) Term)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [(Term, Abs Term)]
sides (((Term, Abs Term)
  -> NamesT (TCMT IO) (NamesT (TCMT IO) Term, NamesT (TCMT IO) Term))
 -> NamesT
      (TCMT IO) [(NamesT (TCMT IO) Term, NamesT (TCMT IO) Term)])
-> ((Term, Abs Term)
    -> NamesT (TCMT IO) (NamesT (TCMT IO) Term, NamesT (TCMT IO) Term))
-> NamesT
     (TCMT IO) [(NamesT (TCMT IO) Term, NamesT (TCMT IO) Term)]
forall a b. (a -> b) -> a -> b
$ \ (Term
psi,Abs Term
u') -> do
        NamesT (TCMT IO) (Abs Term)
u' <- Abs Term -> NamesT (TCMT IO) (NamesT (TCMT IO) (Abs Term))
forall (m :: * -> *) a.
(MonadFail m, Subst a) =>
a -> NamesT m (NamesT m a)
open Abs Term
u'
        Term
u <- String
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
lam String
"i" ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
 -> NamesT (TCMT IO) Term)
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall a b. (a -> b) -> a -> b
$ \ NamesT (TCMT IO) Term
i -> String
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
ilam String
"o" ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
 -> NamesT (TCMT IO) Term)
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall a b. (a -> b) -> a -> b
$ \ NamesT (TCMT IO) Term
o -> Abs Term -> Term -> Term
Abs Term -> SubstArg Term -> Term
forall a. Subst a => Abs a -> SubstArg a -> a
absApp (Abs Term -> Term -> Term)
-> NamesT (TCMT IO) (Abs Term) -> NamesT (TCMT IO) (Term -> Term)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamesT (TCMT IO) (Abs Term)
u' NamesT (TCMT IO) (Term -> Term)
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall a b.
NamesT (TCMT IO) (a -> b)
-> NamesT (TCMT IO) a -> NamesT (TCMT IO) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> NamesT (TCMT IO) Term
i
        (,) (NamesT (TCMT IO) Term
 -> NamesT (TCMT IO) Term
 -> (NamesT (TCMT IO) Term, NamesT (TCMT IO) Term))
-> NamesT (TCMT IO) (NamesT (TCMT IO) Term)
-> NamesT
     (TCMT IO)
     (NamesT (TCMT IO) Term
      -> (NamesT (TCMT IO) Term, NamesT (TCMT IO) Term))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term -> NamesT (TCMT IO) (NamesT (TCMT IO) Term)
forall (m :: * -> *) a.
(MonadFail m, Subst a) =>
a -> NamesT m (NamesT m a)
open Term
psi NamesT
  (TCMT IO)
  (NamesT (TCMT IO) Term
   -> (NamesT (TCMT IO) Term, NamesT (TCMT IO) Term))
-> NamesT (TCMT IO) (NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) (NamesT (TCMT IO) Term, NamesT (TCMT IO) Term)
forall a b.
NamesT (TCMT IO) (a -> b)
-> NamesT (TCMT IO) a -> NamesT (TCMT IO) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Term -> NamesT (TCMT IO) (NamesT (TCMT IO) Term)
forall (m :: * -> *) a.
(MonadFail m, Subst a) =>
a -> NamesT m (NamesT m a)
open Term
u

    let rhs :: NamesT (TCMT IO) Term
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)

    (,,) ([NamedArg DeBruijnPattern]
 -> Dom Type
 -> Term
 -> ([NamedArg DeBruijnPattern], Dom Type, Term))
-> NamesT (TCMT IO) [NamedArg DeBruijnPattern]
-> NamesT
     (TCMT IO)
     (Dom Type -> Term -> ([NamedArg DeBruijnPattern], Dom Type, Term))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamesT (TCMT IO) [NamedArg DeBruijnPattern]
ps NamesT
  (TCMT IO)
  (Dom Type -> Term -> ([NamedArg DeBruijnPattern], Dom Type, Term))
-> NamesT (TCMT IO) (Dom Type)
-> NamesT
     (TCMT IO) (Term -> ([NamedArg DeBruijnPattern], Dom Type, Term))
forall a b.
NamesT (TCMT IO) (a -> b)
-> NamesT (TCMT IO) a -> NamesT (TCMT IO) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> NamesT (TCMT IO) (Dom Type)
rhsTy NamesT
  (TCMT IO) (Term -> ([NamedArg DeBruijnPattern], Dom Type, Term))
-> NamesT (TCMT IO) Term
-> NamesT (TCMT IO) ([NamedArg DeBruijnPattern], Dom Type, Term)
forall a b.
NamesT (TCMT IO) (a -> b)
-> NamesT (TCMT IO) a -> NamesT (TCMT IO) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> NamesT (TCMT IO) Term
rhs

  let ([NamedArg DeBruijnPattern]
ps,Dom Type
ty,Term
rhs) = AbsN ([NamedArg DeBruijnPattern], Dom Type, Term)
-> ([NamedArg DeBruijnPattern], Dom Type, Term)
forall a. AbsN a -> a
unAbsN (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term)
 -> ([NamedArg DeBruijnPattern], Dom Type, Term))
-> AbsN ([NamedArg DeBruijnPattern], Dom Type, Term)
-> ([NamedArg DeBruijnPattern], Dom Type, Term)
forall a b. (a -> b) -> a -> b
$ AbsN (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term))
-> AbsN ([NamedArg DeBruijnPattern], Dom Type, Term)
forall a. AbsN a -> a
unAbsN (AbsN (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term))
 -> AbsN ([NamedArg DeBruijnPattern], Dom Type, Term))
-> AbsN (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term))
-> AbsN ([NamedArg DeBruijnPattern], Dom Type, Term)
forall a b. (a -> b) -> a -> b
$ Abs (AbsN (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term)))
-> AbsN (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term))
forall a. Abs a -> a
unAbs (Abs (AbsN (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term)))
 -> AbsN (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term)))
-> Abs (AbsN (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term)))
-> AbsN (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term))
forall a b. (a -> b) -> a -> b
$ AbsN
  (Abs (AbsN (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term))))
-> Abs (AbsN (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term)))
forall a. AbsN a -> a
unAbsN (AbsN
   (Abs (AbsN (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term))))
 -> Abs (AbsN (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term))))
-> AbsN
     (Abs (AbsN (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term))))
-> Abs (AbsN (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term)))
forall a b. (a -> b) -> a -> b
$ AbsN
  (Abs (AbsN (AbsN ([NamedArg DeBruijnPattern], Dom Type, Term))))
ps_ty_rhs
  [QName]
qs <- (PrimitiveId -> TCMT IO QName) -> [PrimitiveId] -> TCMT IO [QName]
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 ((Maybe QName -> QName) -> TCMT IO (Maybe QName) -> TCMT IO QName
forall a b. (a -> b) -> TCMT IO a -> TCMT IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (QName -> Maybe QName -> QName
forall a. a -> Maybe a -> a
fromMaybe QName
forall a. HasCallStack => a
__IMPOSSIBLE__) (TCMT IO (Maybe QName) -> TCMT IO QName)
-> (PrimitiveId -> TCMT IO (Maybe QName))
-> PrimitiveId
-> TCMT IO QName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrimitiveId -> TCMT IO (Maybe QName)
forall (m :: * -> *) a.
(HasBuiltins m, IsBuiltin a) =>
a -> m (Maybe QName)
getName') [PrimitiveId
builtinINeg, PrimitiveId
builtinIMax, PrimitiveId
builtinIMin]
  Term
rhs <- Telescope -> TCMT IO Term -> TCMT IO Term
forall b (m :: * -> *) a.
(AddContext b, MonadAddContext m) =>
b -> m a -> m a
forall (m :: * -> *) a.
MonadAddContext m =>
Telescope -> m a -> m a
addContext Telescope
cTel (TCMT IO Term -> TCMT IO Term) -> TCMT IO Term -> TCMT IO Term
forall a b. (a -> b) -> a -> b
$
           ReduceDefs -> TCMT IO Term -> TCMT IO Term
forall (m :: * -> *) a. MonadTCEnv m => ReduceDefs -> m a -> m a
locallyReduceDefs (Set QName -> ReduceDefs
OnlyReduceDefs ([QName] -> Set QName
forall a. Ord a => [a] -> Set a
Set.fromList ([QName] -> Set QName) -> [QName] -> Set QName
forall a b. (a -> b) -> a -> b
$ QName
q_trX QName -> [QName] -> [QName]
forall a. a -> [a] -> [a]
: [QName]
qs)) (TCMT IO Term -> TCMT IO Term) -> TCMT IO Term -> TCMT IO Term
forall a b. (a -> b) -> a -> b
$ Term -> TCMT IO Term
forall a (m :: * -> *). (Normalise a, MonadReduce m) => a -> m a
normalise Term
rhs
  let cl :: Clause
cl = Clause { clauseLHSRange :: Range
clauseLHSRange  = Range
forall a. Range' a
noRange
                  , clauseFullRange :: Range
clauseFullRange = Range
forall a. Range' a
noRange
                  , clauseTel :: Telescope
clauseTel       = Telescope
cTel
                  , namedClausePats :: [NamedArg DeBruijnPattern]
namedClausePats = [NamedArg DeBruijnPattern]
ps
                  , clauseBody :: Maybe Term
clauseBody      = Term -> Maybe Term
forall a. a -> Maybe a
Just Term
rhs
                  , clauseType :: Maybe (Arg Type)
clauseType      = Arg Type -> Maybe (Arg Type)
forall a. a -> Maybe a
Just (Arg Type -> Maybe (Arg Type)) -> Arg Type -> Maybe (Arg Type)
forall a b. (a -> b) -> a -> b
$ ArgInfo -> Type -> Arg Type
forall e. ArgInfo -> e -> Arg e
Arg (Dom Type -> ArgInfo
forall a. LensArgInfo a => a -> ArgInfo
getArgInfo Dom Type
ty) (Dom Type -> Type
forall t e. Dom' t e -> e
unDom Dom Type
ty)
                  , clauseCatchall :: Bool
clauseCatchall    = Bool
False
                  , clauseExact :: Maybe Bool
clauseExact       = Maybe Bool
forall a. Maybe a
Nothing
                  , clauseRecursive :: Maybe Bool
clauseRecursive   = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True
                  , clauseUnreachable :: Maybe Bool
clauseUnreachable = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False
                  , clauseEllipsis :: ExpandedEllipsis
clauseEllipsis    = ExpandedEllipsis
NoEllipsis
                  , clauseWhereModule :: Maybe ModuleName
clauseWhereModule = Maybe ModuleName
forall a. Maybe a
Nothing
                  }


  String -> Clause -> TCMT IO ()
debugClause String
"tc.cover.trxcon" Clause
cl

  String -> Int -> TCMT IO Doc -> TCMT IO ()
forall (m :: * -> *).
MonadDebug m =>
String -> Int -> TCMT IO Doc -> m ()
reportSDoc String
"tc.cover.trxcon" Int
20 (TCMT IO Doc -> TCMT IO ()) -> TCMT IO Doc -> TCMT IO ()
forall a b. (a -> b) -> a -> b
$ [TCMT IO Doc] -> 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
"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 (QNamed Clause -> TCMT IO Doc)
-> (Clause -> QNamed Clause) -> Clause -> TCMT IO Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QName -> Clause -> QNamed Clause
forall a. QName -> a -> QNamed a
QNamed QName
f (Clause -> TCMT IO Doc) -> Clause -> TCMT IO Doc
forall a b. (a -> b) -> a -> b
$ Clause
cl
    ]

  let mod :: Modality
mod =
        Relevance -> Modality -> Modality
forall a. LensRelevance a => Relevance -> a -> a
setRelevance Relevance
Irrelevant (Modality -> Modality) -> Modality -> Modality
forall a b. (a -> b) -> a -> b
$  -- See #5611.
        Dom Type -> Modality
forall a. LensModality a => a -> Modality
getModality (Dom Type -> Modality) -> Dom Type -> Modality
forall a b. (a -> b) -> a -> b
$ Dom Type -> Maybe (Dom Type) -> Dom Type
forall a. a -> Maybe a -> a
fromMaybe Dom Type
forall a. HasCallStack => a
__IMPOSSIBLE__ (Maybe (Dom Type) -> Dom Type) -> Maybe (Dom Type) -> Dom Type
forall a b. (a -> b) -> a -> b
$ SplitClause -> Maybe (Dom Type)
scTarget SplitClause
old_sc
  -- we follow what `cover` does when updating the modality from the target.
  Modality -> TCMT IO () -> TCMT IO ()
forall (tcm :: * -> *) m a.
(MonadTCEnv tcm, LensModality m) =>
m -> tcm a -> tcm a
applyModalityToContext Modality
mod (TCMT IO () -> TCMT IO ()) -> TCMT IO () -> TCMT IO ()
forall a b. (a -> b) -> a -> b
$ do
    TCMT IO Bool -> TCMT IO () -> TCMT IO ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
unlessM (Quantity -> Bool
forall a. LensQuantity a => a -> Bool
hasQuantity0 (Quantity -> Bool) -> TCMT IO Quantity -> TCMT IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Lens' TCEnv Quantity -> TCMT IO Quantity
forall (m :: * -> *) a. MonadTCEnv m => Lens' TCEnv a -> m a
viewTC (Quantity -> f Quantity) -> TCEnv -> f TCEnv
Lens' TCEnv Quantity
eQuantity) (TCMT IO () -> TCMT IO ()) -> TCMT IO () -> TCMT IO ()
forall a b. (a -> b) -> a -> b
$ do
    String -> Int -> TCMT IO Doc -> TCMT IO ()
forall (m :: * -> *).
MonadDebug m =>
String -> Int -> TCMT IO Doc -> m ()
reportSDoc String
"tc.cover.trxcon" Int
20 (TCMT IO Doc -> TCMT IO ()) -> TCMT IO Doc -> TCMT IO ()
forall a b. (a -> b) -> a -> b
$ String -> TCMT IO Doc
forall (m :: * -> *). Applicative m => String -> m Doc
text String
"testing usable at mod: " TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> Modality -> TCMT IO Doc
forall (m :: * -> *) a. (Applicative m, Pretty a) => a -> m Doc
pretty Modality
mod
    Telescope -> TCMT IO () -> TCMT IO ()
forall b (m :: * -> *) a.
(AddContext b, MonadAddContext m) =>
b -> m a -> m a
forall (m :: * -> *) a.
MonadAddContext m =>
Telescope -> m a -> m a
addContext Telescope
cTel (TCMT IO () -> TCMT IO ()) -> TCMT IO () -> TCMT IO ()
forall a b. (a -> b) -> a -> b
$ WhyCheckModality -> Modality -> Term -> TCMT IO ()
MonadConstraint (TCMT IO) =>
WhyCheckModality -> Modality -> Term -> TCMT IO ()
usableAtModality WhyCheckModality
IndexedClause Modality
mod Term
rhs

  Clause -> TCM Clause
forall a. a -> TCMT IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Clause
cl

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

  -- old_tel = Γ(x: Id A u v)Δ
  -- Γ(x: Id A u v)Δ ⊢ old_t
  -- Γ ⊢ hdelta = (x : Id A u v)(δ : Δ)
      pair :: (Telescope, Telescope)
pair@(Telescope
_gamma,_hdelta :: Telescope
_hdelta@(ExtendTel Dom Type
hdom Abs Telescope
delta)) = Int -> Telescope -> (Telescope, Telescope)
splitTelescopeAt (Telescope -> Int
forall a. Sized a => a -> Int
size Telescope
old_tel Int -> Int -> Int
forall a. Num a => a -> a -> a
- (BlockingVar -> Int
blockingVarNo BlockingVar
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)) Telescope
old_tel
      (Telescope
gamma,AbsN Telescope
hdelta) = (Telescope, Telescope) -> (Telescope, AbsN Telescope)
forall {a}. (Telescope, a) -> (Telescope, AbsN a)
bindSplit (Telescope, Telescope)
pair
      old_t :: AbsN (Dom Type)
old_t  = [String] -> Dom Type -> AbsN (Dom Type)
forall a. [String] -> a -> AbsN a
AbsN (Telescope -> [String]
teleNames Telescope
old_tel) (Dom Type -> AbsN (Dom Type)) -> Dom Type -> AbsN (Dom Type)
forall a b. (a -> b) -> a -> b
$ Maybe (Dom Type) -> Dom Type
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (Dom Type) -> Dom Type) -> Maybe (Dom Type) -> Dom Type
forall a b. (a -> b) -> a -> b
$ SplitClause -> Maybe (Dom Type)
scTarget SplitClause
old_sc
      old_ps :: AbsN [Elim]
old_ps = [String] -> [Elim] -> AbsN [Elim]
forall a. [String] -> a -> AbsN a
AbsN (Telescope -> [String]
teleNames Telescope
old_tel) ([Elim] -> AbsN [Elim]) -> [Elim] -> AbsN [Elim]
forall a b. (a -> b) -> a -> b
$ [NamedArg DeBruijnPattern] -> [Elim]
patternsToElims ([NamedArg DeBruijnPattern] -> [Elim])
-> [NamedArg DeBruijnPattern] -> [Elim]
forall a b. (a -> b) -> a -> b
$ [NamedArg SplitPattern] -> [NamedArg DeBruijnPattern]
fromSplitPatterns ([NamedArg SplitPattern] -> [NamedArg DeBruijnPattern])
-> [NamedArg SplitPattern] -> [NamedArg DeBruijnPattern]
forall a b. (a -> b) -> a -> b
$ SplitClause -> [NamedArg SplitPattern]
scPats SplitClause
old_sc
      old_ps' :: AbsN [NamedArg DeBruijnPattern]
old_ps' = [String]
-> [NamedArg DeBruijnPattern] -> AbsN [NamedArg DeBruijnPattern]
forall a. [String] -> a -> AbsN a
AbsN (Telescope -> [String]
teleNames Telescope
old_tel) ([NamedArg DeBruijnPattern] -> AbsN [NamedArg DeBruijnPattern])
-> [NamedArg DeBruijnPattern] -> AbsN [NamedArg DeBruijnPattern]
forall a b. (a -> b) -> a -> b
$ [NamedArg SplitPattern] -> [NamedArg DeBruijnPattern]
fromSplitPatterns ([NamedArg SplitPattern] -> [NamedArg DeBruijnPattern])
-> [NamedArg SplitPattern] -> [NamedArg DeBruijnPattern]
forall a b. (a -> b) -> a -> b
$ SplitClause -> [NamedArg SplitPattern]
scPats SplitClause
old_sc

  AbsN [Term]
params <- [String] -> NamesT (TCMT IO) (AbsN [Term]) -> TCMT IO (AbsN [Term])
forall (m :: * -> *) a. [String] -> NamesT m a -> m a
runNamesT [] (NamesT (TCMT IO) (AbsN [Term]) -> TCMT IO (AbsN [Term]))
-> NamesT (TCMT IO) (AbsN [Term]) -> TCMT IO (AbsN [Term])
forall a b. (a -> b) -> a -> b
$ do
    NamesT (TCMT IO) (AbsN Telescope)
hdelta <- AbsN Telescope
-> NamesT (TCMT IO) (NamesT (TCMT IO) (AbsN Telescope))
forall (m :: * -> *) a.
(MonadFail m, Subst a) =>
a -> NamesT m (NamesT m a)
open AbsN Telescope
hdelta
    [String]
-> (Vars (TCMT IO) -> NamesT (TCMT IO) [Term])
-> NamesT (TCMT IO) (AbsN [Term])
forall (m :: * -> *) a.
MonadFail m =>
[String] -> (Vars m -> NamesT m a) -> NamesT m (AbsN a)
bindN (Telescope -> [String]
teleNames Telescope
gamma) ((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)
args -> do
       hdelta :: Telescope
hdelta@(ExtendTel Dom Type
hdom Abs Telescope
_) <- NamesT (TCMT IO) (AbsN Telescope)
-> [NamesT (TCMT IO) (SubstArg Telescope)]
-> NamesT (TCMT IO) Telescope
forall (m :: * -> *) a.
(Monad m, Subst a) =>
NamesT m (AbsN a) -> [NamesT m (SubstArg a)] -> NamesT m a
applyN NamesT (TCMT IO) (AbsN Telescope)
hdelta [NamesT (TCMT IO) Term]
[NamesT (TCMT IO) (SubstArg Telescope)]
Vars (TCMT IO)
args
       Def QName
_Id es :: [Elim]
es@[Elim
_,Elim
_,Elim
_,Elim
_] <- Term -> NamesT (TCMT IO) Term
forall a (m :: * -> *). (Reduce a, MonadReduce m) => a -> m a
reduce (Term -> NamesT (TCMT IO) Term) -> Term -> NamesT (TCMT IO) Term
forall a b. (a -> b) -> a -> b
$ Type -> Term
forall t a. Type'' t a -> a
unEl (Type -> Term) -> Type -> Term
forall a b. (a -> b) -> a -> b
$ Dom Type -> Type
forall t e. Dom' t e -> e
unDom Dom Type
hdom
       [Term] -> NamesT (TCMT IO) [Term]
forall a. a -> NamesT (TCMT IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Term] -> NamesT (TCMT IO) [Term])
-> [Term] -> NamesT (TCMT IO) [Term]
forall a b. (a -> b) -> a -> b
$ (Arg Term -> Term) -> Args -> [Term]
forall a b. (a -> b) -> [a] -> [b]
map Arg Term -> Term
forall e. Arg e -> e
unArg (Args -> [Term]) -> Args -> [Term]
forall a b. (a -> b) -> a -> b
$ Args -> Maybe Args -> Args
forall a. a -> Maybe a -> a
fromMaybe Args
forall a. HasCallStack => a
__IMPOSSIBLE__ (Maybe Args -> Args) -> Maybe Args -> Args
forall a b. (a -> b) -> a -> b
$ [Elim] -> Maybe Args
forall a. [Elim' a] -> Maybe [Arg a]
allApplyElims [Elim]
es

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

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

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

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

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

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

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

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

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

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

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

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

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

      ExceptT (Closure (Abs Type)) (TCMT IO) Args
m <- Bool
-> Abs Telescope
-> Term
-> Args
-> Term
-> ExceptT (Closure (Abs Type)) (TCMT IO) Args
forall (m :: * -> *).
(PureTCM m, MonadError TCErr m) =>
Bool
-> Abs Telescope
-> Term
-> Args
-> Term
-> ExceptT (Closure (Abs Type)) m Args
trFillTel' Bool
True (Abs Telescope
 -> Term
 -> Args
 -> Term
 -> ExceptT (Closure (Abs Type)) (TCMT IO) Args)
-> NamesT (TCMT IO) (Abs Telescope)
-> NamesT
     (TCMT IO)
     (Term
      -> Args -> Term -> ExceptT (Closure (Abs Type)) (TCMT IO) Args)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamesT (TCMT IO) (Abs Telescope)
delta_f NamesT
  (TCMT IO)
  (Term
   -> Args -> Term -> ExceptT (Closure (Abs Type)) (TCMT IO) Args)
-> NamesT (TCMT IO) Term
-> NamesT
     (TCMT IO)
     (Args -> Term -> ExceptT (Closure (Abs Type)) (TCMT IO) Args)
forall a b.
NamesT (TCMT IO) (a -> b)
-> NamesT (TCMT IO) a -> NamesT (TCMT IO) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> NamesT (TCMT IO) Term
phi NamesT
  (TCMT IO)
  (Args -> Term -> ExceptT (Closure (Abs Type)) (TCMT IO) Args)
-> NamesT (TCMT IO) Args
-> NamesT
     (TCMT IO) (Term -> ExceptT (Closure (Abs Type)) (TCMT IO) Args)
forall a b.
NamesT (TCMT IO) (a -> b)
-> NamesT (TCMT IO) a -> NamesT (TCMT IO) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> NamesT (TCMT IO) Args
delta_args NamesT
  (TCMT IO) (Term -> ExceptT (Closure (Abs Type)) (TCMT IO) Args)
-> NamesT (TCMT IO) Term
-> NamesT (TCMT IO) (ExceptT (Closure (Abs Type)) (TCMT IO) Args)
forall a b.
NamesT (TCMT IO) (a -> b)
-> NamesT (TCMT IO) a -> NamesT (TCMT IO) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> NamesT (TCMT IO) Term
Var (TCMT IO)
i
      (Closure (Abs Type) -> Args)
-> (Args -> Args) -> Either (Closure (Abs Type)) Args -> Args
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Closure (Abs Type) -> Args
forall a. HasCallStack => a
__IMPOSSIBLE__ Args -> Args
forall a. a -> a
id (Either (Closure (Abs Type)) Args -> Args)
-> NamesT (TCMT IO) (Either (Closure (Abs Type)) Args)
-> NamesT (TCMT IO) Args
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (TCM (Either (Closure (Abs Type)) Args)
-> NamesT (TCMT IO) (Either (Closure (Abs Type)) Args)
forall (m :: * -> *) a. Monad m => m a -> NamesT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (TCM (Either (Closure (Abs Type)) Args)
 -> NamesT (TCMT IO) (Either (Closure (Abs Type)) Args))
-> TCM (Either (Closure (Abs Type)) Args)
-> NamesT (TCMT IO) (Either (Closure (Abs Type)) Args)
forall a b. (a -> b) -> a -> b
$ ExceptT (Closure (Abs Type)) (TCMT IO) Args
-> TCM (Either (Closure (Abs Type)) Args)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT ExceptT (Closure (Abs Type)) (TCMT IO) Args
m)
    NamesT (TCMT IO) (Abs Args)
delta_args_f <- Abs Args -> NamesT (TCMT IO) (NamesT (TCMT IO) (Abs Args))
forall (m :: * -> *) a.
(MonadFail m, Subst a) =>
a -> NamesT m (NamesT m a)
open Abs Args
delta_args_f
    NamesT (TCMT IO) (Abs (Dom Type))
old_t_f <- (Abs (Dom Type)
-> NamesT (TCMT IO) (NamesT (TCMT IO) (Abs (Dom Type)))
forall (m :: * -> *) a.
(MonadFail m, Subst a) =>
a -> NamesT m (NamesT m a)
open (Abs (Dom Type)
 -> NamesT (TCMT IO) (NamesT (TCMT IO) (Abs (Dom Type))))
-> NamesT (TCMT IO) (Abs (Dom Type))
-> NamesT (TCMT IO) (NamesT (TCMT IO) (Abs (Dom Type)))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (NamesT (TCMT IO) (Abs (Dom Type))
 -> NamesT (TCMT IO) (NamesT (TCMT IO) (Abs (Dom Type))))
-> NamesT (TCMT IO) (Abs (Dom Type))
-> NamesT (TCMT IO) (NamesT (TCMT IO) (Abs (Dom Type)))
forall a b. (a -> b) -> a -> b
$ String
-> (Var (TCMT IO) -> NamesT (TCMT IO) (Dom Type))
-> NamesT (TCMT IO) (Abs (Dom Type))
forall (m :: * -> *) a.
MonadFail m =>
String
-> ((forall b. (Subst b, DeBruijn b) => NamesT m b) -> NamesT m a)
-> NamesT m (Abs a)
bind String
"i" ((Var (TCMT IO) -> NamesT (TCMT IO) (Dom Type))
 -> NamesT (TCMT IO) (Abs (Dom Type)))
-> (Var (TCMT IO) -> NamesT (TCMT IO) (Dom Type))
-> NamesT (TCMT IO) (Abs (Dom Type))
forall a b. (a -> b) -> a -> b
$ \ Var (TCMT IO)
i -> do
      [Term]
g <- Abs [Term] -> Term -> [Term]
Abs [Term] -> SubstArg [Term] -> [Term]
forall a. Subst a => Abs a -> SubstArg a -> a
lazyAbsApp (Abs [Term] -> Term -> [Term])
-> NamesT (TCMT IO) (Abs [Term])
-> NamesT (TCMT IO) (Term -> [Term])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamesT (TCMT IO) (Abs [Term])
gamma_args_left NamesT (TCMT IO) (Term -> [Term])
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) [Term]
forall a b.
NamesT (TCMT IO) (a -> b)
-> NamesT (TCMT IO) a -> NamesT (TCMT IO) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> NamesT (TCMT IO) Term
Var (TCMT IO)
i
      Term
x <- Abs Term -> Term -> Term
Abs Term -> SubstArg Term -> Term
forall a. Subst a => Abs a -> SubstArg a -> a
lazyAbsApp (Abs Term -> Term -> Term)
-> NamesT (TCMT IO) (Abs Term) -> NamesT (TCMT IO) (Term -> Term)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamesT (TCMT IO) (Abs Term)
con_phi_p_left NamesT (TCMT IO) (Term -> Term)
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall a b.
NamesT (TCMT IO) (a -> b)
-> NamesT (TCMT IO) a -> NamesT (TCMT IO) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> NamesT (TCMT IO) Term
Var (TCMT IO)
i
      Args
d <- Abs Args -> Term -> Args
Abs Args -> SubstArg Args -> Args
forall a. Subst a => Abs a -> SubstArg a -> a
lazyAbsApp (Abs Args -> Term -> Args)
-> NamesT (TCMT IO) (Abs Args) -> NamesT (TCMT IO) (Term -> Args)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamesT (TCMT IO) (Abs Args)
delta_args_f NamesT (TCMT IO) (Term -> Args)
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Args
forall a b.
NamesT (TCMT IO) (a -> b)
-> NamesT (TCMT IO) a -> NamesT (TCMT IO) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (TCMT IO Term -> NamesT (TCMT IO) Term
forall (m :: * -> *) a. Monad m => m a -> NamesT m a
cl TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primINeg NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT (TCMT IO) Term
Var (TCMT IO)
i)
      NamesT (TCMT IO) [Term]
args <- [Term] -> NamesT (TCMT IO) (NamesT (TCMT IO) [Term])
forall (m :: * -> *) a.
(MonadFail m, Subst a) =>
a -> NamesT m (NamesT m a)
open ([Term] -> NamesT (TCMT IO) (NamesT (TCMT IO) [Term]))
-> [Term] -> NamesT (TCMT IO) (NamesT (TCMT IO) [Term])
forall a b. (a -> b) -> a -> b
$ [Term]
g [Term] -> [Term] -> [Term]
forall a. [a] -> [a] -> [a]
++ [Term
x] [Term] -> [Term] -> [Term]
forall a. [a] -> [a] -> [a]
++ (Arg Term -> Term) -> Args -> [Term]
forall a b. (a -> b) -> [a] -> [b]
map Arg Term -> Term
forall e. Arg e -> e
unArg Args
d
      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) (AbsN (Dom Type))
old_t NamesT (TCMT IO) [Term]
NamesT (TCMT IO) [SubstArg (Dom Type)]
args
    NamesT (TCMT IO) (Abs Term)
w <- (Abs Term -> NamesT (TCMT IO) (NamesT (TCMT IO) (Abs Term))
forall (m :: * -> *) a.
(MonadFail m, Subst a) =>
a -> NamesT m (NamesT m a)
open (Abs Term -> NamesT (TCMT IO) (NamesT (TCMT IO) (Abs Term)))
-> NamesT (TCMT IO) (Abs Term)
-> NamesT (TCMT IO) (NamesT (TCMT IO) (Abs Term))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (NamesT (TCMT IO) (Abs Term)
 -> NamesT (TCMT IO) (NamesT (TCMT IO) (Abs Term)))
-> NamesT (TCMT IO) (Abs Term)
-> NamesT (TCMT IO) (NamesT (TCMT IO) (Abs Term))
forall a b. (a -> b) -> a -> b
$ String
-> (Var (TCMT IO) -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) (Abs Term)
forall (m :: * -> *) a.
MonadFail m =>
String
-> ((forall b. (Subst b, DeBruijn b) => NamesT m b) -> NamesT m a)
-> NamesT m (Abs a)
bind String
"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
      [Term]
g <- Abs [Term] -> Term -> [Term]
Abs [Term] -> SubstArg [Term] -> [Term]
forall a. Subst a => Abs a -> SubstArg a -> a
lazyAbsApp (Abs [Term] -> Term -> [Term])
-> NamesT (TCMT IO) (Abs [Term])
-> NamesT (TCMT IO) (Term -> [Term])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamesT (TCMT IO) (Abs [Term])
gamma_args_left NamesT (TCMT IO) (Term -> [Term])
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) [Term]
forall a b.
NamesT (TCMT IO) (a -> b)
-> NamesT (TCMT IO) a -> NamesT (TCMT IO) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> NamesT (TCMT IO) Term
Var (TCMT IO)
i
      Term
x <- Abs Term -> Term -> Term
Abs Term -> SubstArg Term -> Term
forall a. Subst a => Abs a -> SubstArg a -> a
lazyAbsApp (Abs Term -> Term -> Term)
-> NamesT (TCMT IO) (Abs Term) -> NamesT (TCMT IO) (Term -> Term)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamesT (TCMT IO) (Abs Term)
con_phi_p_left NamesT (TCMT IO) (Term -> Term)
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall a b.
NamesT (TCMT IO) (a -> b)
-> NamesT (TCMT IO) a -> NamesT (TCMT IO) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> NamesT (TCMT IO) Term
Var (TCMT IO)
i
      Args
d <- Abs Args -> Term -> Args
Abs Args -> SubstArg Args -> Args
forall a. Subst a => Abs a -> SubstArg a -> a
lazyAbsApp (Abs Args -> Term -> Args)
-> NamesT (TCMT IO) (Abs Args) -> NamesT (TCMT IO) (Term -> Args)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamesT (TCMT IO) (Abs Args)
delta_args_f NamesT (TCMT IO) (Term -> Args)
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Args
forall a b.
NamesT (TCMT IO) (a -> b)
-> NamesT (TCMT IO) a -> NamesT (TCMT IO) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (TCMT IO Term -> NamesT (TCMT IO) Term
forall (m :: * -> *) a. Monad m => m a -> NamesT m a
cl TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primINeg NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT (TCMT IO) Term
Var (TCMT IO)
i)
      NamesT (TCMT IO) [Term]
args <- [Term] -> NamesT (TCMT IO) (NamesT (TCMT IO) [Term])
forall (m :: * -> *) a.
(MonadFail m, Subst a) =>
a -> NamesT m (NamesT m a)
open ([Term] -> NamesT (TCMT IO) (NamesT (TCMT IO) [Term]))
-> [Term] -> NamesT (TCMT IO) (NamesT (TCMT IO) [Term])
forall a b. (a -> b) -> a -> b
$ [Term]
g [Term] -> [Term] -> [Term]
forall a. [a] -> [a] -> [a]
++ [Term
x] [Term] -> [Term] -> [Term]
forall a. [a] -> [a] -> [a]
++ (Arg Term -> Term) -> Args -> [Term]
forall a b. (a -> b) -> [a] -> [b]
map Arg Term -> Term
forall e. Arg e -> e
unArg Args
d
      QName -> [Elim] -> Term
Def QName
f ([Elim] -> Term)
-> NamesT (TCMT IO) [Elim] -> NamesT (TCMT IO) Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamesT (TCMT IO) (AbsN [Elim])
-> NamesT (TCMT IO) [SubstArg [Elim]] -> NamesT (TCMT IO) [Elim]
forall (m :: * -> *) a.
(Monad m, Subst a) =>
NamesT m (AbsN a) -> NamesT m [SubstArg a] -> NamesT m a
applyN' NamesT (TCMT IO) (AbsN [Elim])
old_ps NamesT (TCMT IO) [Term]
NamesT (TCMT IO) [SubstArg [Elim]]
args

    NamesT (TCMT IO) [NamedArg DeBruijnPattern]
ps <- [NamedArg DeBruijnPattern]
-> NamesT (TCMT IO) (NamesT (TCMT IO) [NamedArg DeBruijnPattern])
forall (m :: * -> *) a.
(MonadFail m, Subst a) =>
a -> NamesT m (NamesT m a)
open [NamedArg DeBruijnPattern]
ps
    Term
max <- NamesT (TCMT IO) Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primIMax
    Term
iz <- NamesT (TCMT IO) Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primIZero
    NamesT (TCMT IO) Term
alphas <- (Term -> NamesT (TCMT IO) (NamesT (TCMT IO) Term)
forall (m :: * -> *) a.
(MonadFail m, Subst a) =>
a -> NamesT m (NamesT m a)
open (Term -> NamesT (TCMT IO) (NamesT (TCMT IO) Term))
-> NamesT (TCMT IO) Term
-> NamesT (TCMT IO) (NamesT (TCMT IO) Term)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (NamesT (TCMT IO) Term -> NamesT (TCMT IO) (NamesT (TCMT IO) Term))
-> NamesT (TCMT IO) Term
-> NamesT (TCMT IO) (NamesT (TCMT IO) Term)
forall a b. (a -> b) -> a -> b
$ do
      [Int]
vs <- [NamedArg DeBruijnPattern] -> [Int]
forall p. IApplyVars p => p -> [Int]
iApplyVars ([NamedArg DeBruijnPattern] -> [Int])
-> NamesT (TCMT IO) [NamedArg DeBruijnPattern]
-> NamesT (TCMT IO) [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamesT (TCMT IO) [NamedArg DeBruijnPattern]
ps
      Term
neg <- NamesT (TCMT IO) Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primINeg
      Term
zero <- NamesT (TCMT IO) Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primIZero
      Term -> NamesT (TCMT IO) Term
forall a. a -> NamesT (TCMT IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Term -> NamesT (TCMT IO) Term) -> Term -> NamesT (TCMT IO) Term
forall a b. (a -> b) -> a -> b
$ (Term -> Term -> Term) -> Term -> [Term] -> Term
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\ Term
x Term
r -> Term
max Term -> Args -> Term
forall t. Apply t => t -> Args -> t
`apply` [Term -> Arg Term
forall e. e -> Arg e
argN (Term -> Arg Term) -> Term -> Arg Term
forall a b. (a -> b) -> a -> b
$ Term
max Term -> Args -> Term
forall t. Apply t => t -> Args -> t
`apply` [Term -> Arg Term
forall e. e -> Arg e
argN Term
x, Term -> Arg Term
forall e. e -> Arg e
argN (Term
neg Term -> Args -> Term
forall t. Apply t => t -> Args -> t
`apply` [Term -> Arg Term
forall e. e -> Arg e
argN Term
x])], Term -> Arg Term
forall e. e -> Arg e
argN Term
r]) Term
zero ([Term] -> Term) -> [Term] -> Term
forall a b. (a -> b) -> a -> b
$ (Int -> Term) -> [Int] -> [Term]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Term
var [Int]
vs
    NamesT (TCMT IO) (Abs [(Term, Term)])
sides <- (Abs [(Term, Term)]
-> NamesT (TCMT IO) (NamesT (TCMT IO) (Abs [(Term, Term)]))
forall (m :: * -> *) a.
(MonadFail m, Subst a) =>
a -> NamesT m (NamesT m a)
open (Abs [(Term, Term)]
 -> NamesT (TCMT IO) (NamesT (TCMT IO) (Abs [(Term, Term)])))
-> NamesT (TCMT IO) (Abs [(Term, Term)])
-> NamesT (TCMT IO) (NamesT (TCMT IO) (Abs [(Term, Term)]))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (NamesT (TCMT IO) (Abs [(Term, Term)])
 -> NamesT (TCMT IO) (NamesT (TCMT IO) (Abs [(Term, Term)])))
-> NamesT (TCMT IO) (Abs [(Term, Term)])
-> NamesT (TCMT IO) (NamesT (TCMT IO) (Abs [(Term, Term)]))
forall a b. (a -> b) -> a -> b
$ do
      Term
neg <- NamesT (TCMT IO) Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primINeg
      Term
io <- NamesT (TCMT IO) Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primIOne
      String
-> (Var (TCMT IO) -> NamesT (TCMT IO) [(Term, Term)])
-> NamesT (TCMT IO) (Abs [(Term, Term)])
forall (m :: * -> *) a.
MonadFail m =>
String
-> ((forall b. (Subst b, DeBruijn b) => NamesT m b) -> NamesT m a)
-> NamesT m (Abs a)
bind String
"i" ((Var (TCMT IO) -> NamesT (TCMT IO) [(Term, Term)])
 -> NamesT (TCMT IO) (Abs [(Term, Term)]))
-> (Var (TCMT IO) -> NamesT (TCMT IO) [(Term, Term)])
-> NamesT (TCMT IO) (Abs [(Term, Term)])
forall a b. (a -> b) -> a -> b
$ \ Var (TCMT IO)
i -> do
        [Int]
vs <- [NamedArg DeBruijnPattern] -> [Int]
forall p. IApplyVars p => p -> [Int]
iApplyVars ([NamedArg DeBruijnPattern] -> [Int])
-> NamesT (TCMT IO) [NamedArg DeBruijnPattern]
-> NamesT (TCMT IO) [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamesT (TCMT IO) [NamedArg DeBruijnPattern]
ps
        Term
tm <- Abs Term -> Term -> Term
Abs Term -> SubstArg Term -> Term
forall a. Subst a => Abs a -> SubstArg a -> a
lazyAbsApp (Abs Term -> Term -> Term)
-> NamesT (TCMT IO) (Abs Term) -> NamesT (TCMT IO) (Term -> Term)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamesT (TCMT IO) (Abs Term)
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
<*> NamesT (TCMT IO) Term
Var (TCMT IO)
i
        [(Term, (Term, Term))]
xs <- [Int]
-> (Int -> NamesT (TCMT IO) (Term, (Term, Term)))
-> NamesT (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 -> NamesT (TCMT IO) (Term, (Term, Term)))
 -> NamesT (TCMT IO) [(Term, (Term, Term))])
-> (Int -> NamesT (TCMT IO) (Term, (Term, Term)))
-> NamesT (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)))
-> NamesT (TCMT IO) (Term, Term)
-> NamesT (TCMT IO) (Term, (Term, Term))
forall a b. (a -> b) -> NamesT (TCMT IO) a -> NamesT (TCMT IO) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Term
var Int
v,) (NamesT (TCMT IO) (Term, Term)
 -> NamesT (TCMT IO) (Term, (Term, Term)))
-> ((Term, Term) -> NamesT (TCMT IO) (Term, Term))
-> (Term, Term)
-> NamesT (TCMT IO) (Term, (Term, Term))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Term, Term) -> NamesT (TCMT IO) (Term, Term)
forall a (m :: * -> *). (Reduce a, MonadReduce m) => a -> m a
reduce ((Term, Term) -> NamesT (TCMT IO) (Term, (Term, Term)))
-> (Term, Term) -> NamesT (TCMT IO) (Term, (Term, Term))
forall a b. (a -> b) -> a -> b
$ (Int -> Term -> Substitution' Term
forall a. EndoSubst a => Int -> a -> Substitution' a
inplaceS Int
v Term
iz Substitution' (SubstArg Term) -> Term -> Term
forall a. Subst a => Substitution' (SubstArg a) -> a -> a
`applySubst` Term
tm, Int -> Term -> Substitution' Term
forall a. EndoSubst a => Int -> a -> Substitution' a
inplaceS Int
v Term
io Substitution' (SubstArg Term) -> Term -> Term
forall a. Subst a => Substitution' (SubstArg a) -> a -> a
`applySubst` Term
tm)
        Int
phiv <- Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
forall a. HasCallStack => a
__IMPOSSIBLE__ (Maybe Int -> Int) -> (Term -> Maybe Int) -> Term -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term -> Maybe Int
forall a. DeBruijn a => a -> Maybe Int
deBruijnView (Term -> Int) -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamesT (TCMT IO) Term
phi
        -- extra assumption: phi |- w i = w 0, otherwise we need [ phi -> w 0 ] specifically
        Term
tm_phi <- Term -> NamesT (TCMT IO) Term
forall a (m :: * -> *). (Reduce a, MonadReduce m) => a -> m a
reduce (Term -> NamesT (TCMT IO) Term) -> Term -> NamesT (TCMT IO) Term
forall a b. (a -> b) -> a -> b
$ Int -> Term -> Substitution' Term
forall a. EndoSubst a => Int -> a -> Substitution' a
inplaceS Int
phiv Term
io Substitution' (SubstArg Term) -> Term -> Term
forall a. Subst a => Substitution' (SubstArg a) -> a -> a
`applySubst` Term
tm
        Term
phi <- NamesT (TCMT IO) Term
phi
        [(Term, Term)] -> NamesT (TCMT IO) [(Term, Term)]
forall a. a -> NamesT (TCMT IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Term, Term)] -> NamesT (TCMT IO) [(Term, Term)])
-> [(Term, Term)] -> NamesT (TCMT IO) [(Term, Term)]
forall a b. (a -> b) -> a -> b
$ (Term
phi,Term
tm_phi) (Term, Term) -> [(Term, Term)] -> [(Term, Term)]
forall a. a -> [a] -> [a]
: ((Term, (Term, Term)) -> [(Term, Term)])
-> [(Term, (Term, Term))] -> [(Term, Term)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(Term
v,(Term
l,Term
r)) -> [(Term
neg Term -> Args -> Term
forall t. Apply t => t -> Args -> t
`apply` [Term -> Arg Term
forall e. e -> Arg e
argN Term
v],Term
l),(Term
v,Term
r)]) [(Term, (Term, Term))]
xs

    let imax :: Term -> Term -> Term
imax Term
i Term
j = Term -> Args -> Term
forall t. Apply t => t -> Args -> t
apply Term
max (Args -> Term) -> Args -> Term
forall a b. (a -> b) -> a -> b
$ (Term -> Arg Term) -> [Term] -> Args
forall a b. (a -> b) -> [a] -> [b]
map Term -> Arg Term
forall e. e -> Arg e
argN [Term
i,Term
j]
    Term
tPOr <- Term -> Maybe Term -> Term
forall a. a -> Maybe a -> a
fromMaybe Term
forall a. HasCallStack => a
__IMPOSSIBLE__ (Maybe Term -> Term)
-> NamesT (TCMT IO) (Maybe Term) -> NamesT (TCMT IO) Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PrimitiveId -> NamesT (TCMT IO) (Maybe Term)
forall (m :: * -> *) a.
(HasBuiltins m, IsBuiltin a) =>
a -> m (Maybe Term)
getTerm' PrimitiveId
builtinPOr
    let
      pOr :: NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term
-> Term
-> Term
-> Term
-> NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term
pOr NamesT (TCMT IO) Term
l NamesT (TCMT IO) Term
ty Term
phi Term
psi Term
u0 NamesT (TCMT IO) Term
u1 = do
          [NamesT (TCMT IO) Term
phi,NamesT (TCMT IO) Term
psi] <- (Term -> NamesT (TCMT IO) (NamesT (TCMT IO) Term))
-> [Term] -> NamesT (TCMT IO) [NamesT (TCMT IO) Term]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Term -> NamesT (TCMT IO) (NamesT (TCMT IO) Term)
forall (m :: * -> *) a.
(MonadFail m, Subst a) =>
a -> NamesT m (NamesT m a)
open [Term
phi,Term
psi]
          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
l
                    NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT (TCMT IO) Term
phi NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT (TCMT IO) Term
psi
                    NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> (String
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
ilam String
"o" ((NamesT (TCMT IO) Term -> 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
ty) 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 {m :: * -> *}. MonadFail m => Term -> NamesT m Term
noilam 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

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

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

    let ty :: NamesT (TCMT IO) Term -> NamesT (TCMT IO) (Dom Type)
ty NamesT (TCMT IO) Term
i = Abs (Dom Type) -> Term -> Dom Type
Abs (Dom Type) -> SubstArg (Dom Type) -> Dom Type
forall a. Subst a => Abs a -> SubstArg a -> a
lazyAbsApp (Abs (Dom Type) -> Term -> Dom Type)
-> NamesT (TCMT IO) (Abs (Dom Type))
-> NamesT (TCMT IO) (Term -> Dom Type)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamesT (TCMT IO) (Abs (Dom Type))
old_t_f NamesT (TCMT IO) (Term -> Dom Type)
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) (Dom Type)
forall a b.
NamesT (TCMT IO) (a -> b)
-> NamesT (TCMT IO) a -> NamesT (TCMT IO) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> NamesT (TCMT IO) Term
i
    NamesT (TCMT IO) Term
l <- (Term -> NamesT (TCMT IO) (NamesT (TCMT IO) Term)
forall (m :: * -> *) a.
(MonadFail m, Subst a) =>
a -> NamesT m (NamesT m a)
open (Term -> NamesT (TCMT IO) (NamesT (TCMT IO) Term))
-> NamesT (TCMT IO) Term
-> NamesT (TCMT IO) (NamesT (TCMT IO) Term)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (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
$ String
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
lam String
"i" ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
 -> NamesT (TCMT IO) Term)
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall a b. (a -> b) -> a -> b
$ \ NamesT (TCMT IO) Term
i -> do
           Type
t <- Dom Type -> Type
forall t e. Dom' t e -> e
unDom (Dom Type -> Type)
-> NamesT (TCMT IO) (Dom Type) -> NamesT (TCMT IO) Type
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamesT (TCMT IO) Term -> NamesT (TCMT IO) (Dom Type)
ty NamesT (TCMT IO) Term
i
           TCMT IO Term -> NamesT (TCMT IO) Term
forall (m :: * -> *) a. Monad m => m a -> NamesT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (TCMT IO Term -> NamesT (TCMT IO) Term)
-> TCMT IO Term -> NamesT (TCMT IO) Term
forall a b. (a -> b) -> a -> b
$ Type -> TCMT IO Term
forall {m :: * -> *} {a}.
(LensSort a, MonadError TCErr m, PrettyTCM a, MonadFresh NameId m,
 MonadInteractionPoints m, MonadStConcreteNames m, PureTCM m,
 IsString (m Doc), Null (m Doc), Semigroup (m Doc)) =>
a -> m Term
getLevel Type
t
    ((,) (Dom Type -> Term -> (Dom Type, Term))
-> NamesT (TCMT IO) (Dom Type)
-> NamesT (TCMT IO) (Term -> (Dom Type, Term))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamesT (TCMT IO) Term -> NamesT (TCMT IO) (Dom Type)
ty (TCMT IO Term -> NamesT (TCMT IO) Term
forall (m :: * -> *) a. Monad m => m a -> NamesT m a
cl TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primIOne) NamesT (TCMT IO) (Term -> (Dom Type, Term))
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) (Dom Type, Term)
forall a b.
NamesT (TCMT IO) (a -> b)
-> NamesT (TCMT IO) a -> NamesT (TCMT IO) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>) (NamesT (TCMT IO) Term -> NamesT (TCMT IO) (Dom Type, Term))
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) (Dom Type, Term)
forall a b. (a -> b) -> a -> b
$ do
         Int
n <- [(Term, Term)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([(Term, Term)] -> Int)
-> (Abs [(Term, Term)] -> [(Term, Term)])
-> Abs [(Term, Term)]
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Abs [(Term, Term)] -> [(Term, Term)]
forall a. Abs a -> a
unAbs (Abs [(Term, Term)] -> Int)
-> NamesT (TCMT IO) (Abs [(Term, Term)]) -> NamesT (TCMT IO) Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamesT (TCMT IO) (Abs [(Term, Term)])
sides
         -- TODO don't comp if the family and the sides "j. [ α ↦ u ]" are constant?
         if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 then
           Term -> NamesT (TCMT IO) Term
forall a. a -> NamesT (TCMT IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
tComp 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
l NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> (String
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
lam String
"i" ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
 -> NamesT (TCMT IO) Term)
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall a b. (a -> b) -> a -> b
$ \ NamesT (TCMT IO) Term
i -> Type -> Term
forall t a. Type'' t a -> a
unEl (Type -> Term) -> (Dom Type -> Type) -> Dom Type -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dom Type -> Type
forall t e. Dom' t e -> e
unDom (Dom Type -> Term)
-> NamesT (TCMT IO) (Dom Type) -> NamesT (TCMT IO) Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamesT (TCMT IO) Term -> NamesT (TCMT IO) (Dom Type)
ty NamesT (TCMT IO) Term
i)
                NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> (TCMT IO Term -> NamesT (TCMT IO) Term
forall (m :: * -> *) a. Monad m => m a -> NamesT m a
cl TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primIMax 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
alphas)
                NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> (String
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
lam String
"i" ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
 -> NamesT (TCMT IO) Term)
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall a b. (a -> b) -> a -> b
$ \ NamesT (TCMT IO) Term
i -> NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> [(Term, Term)] -> NamesT (TCMT IO) Term
combine (NamesT (TCMT IO) Term
l NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT (TCMT IO) Term
i) (Type -> Term
forall t a. Type'' t a -> a
unEl (Type -> Term) -> (Dom Type -> Type) -> Dom Type -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dom Type -> Type
forall t e. Dom' t e -> e
unDom (Dom Type -> Term)
-> NamesT (TCMT IO) (Dom Type) -> NamesT (TCMT IO) Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamesT (TCMT IO) Term -> NamesT (TCMT IO) (Dom Type)
ty NamesT (TCMT IO) Term
i) ([(Term, Term)] -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) [(Term, Term)] -> NamesT (TCMT IO) Term
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Abs [(Term, Term)] -> Term -> [(Term, Term)]
Abs [(Term, Term)] -> SubstArg [(Term, Term)] -> [(Term, Term)]
forall a. Subst a => Abs a -> SubstArg a -> a
lazyAbsApp (Abs [(Term, Term)] -> Term -> [(Term, Term)])
-> NamesT (TCMT IO) (Abs [(Term, Term)])
-> NamesT (TCMT IO) (Term -> [(Term, Term)])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamesT (TCMT IO) (Abs [(Term, Term)])
sides NamesT (TCMT IO) (Term -> [(Term, Term)])
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) [(Term, Term)]
forall a b.
NamesT (TCMT IO) (a -> b)
-> NamesT (TCMT IO) a -> NamesT (TCMT IO) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> NamesT (TCMT IO) Term
i))
                NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> (Abs Term -> Term -> Term
Abs Term -> SubstArg Term -> Term
forall a. Subst a => Abs a -> SubstArg a -> a
lazyAbsApp (Abs Term -> Term -> Term)
-> NamesT (TCMT IO) (Abs Term) -> NamesT (TCMT IO) (Term -> Term)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamesT (TCMT IO) (Abs Term)
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
<*> NamesT (TCMT IO) Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primIZero)
         else
           Term -> NamesT (TCMT IO) Term
forall a. a -> NamesT (TCMT IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
tTrans 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
l NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> (String
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
lam String
"i" ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
 -> NamesT (TCMT IO) Term)
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall a b. (a -> b) -> a -> b
$ \ NamesT (TCMT IO) Term
i -> Type -> Term
forall t a. Type'' t a -> a
unEl (Type -> Term) -> (Dom Type -> Type) -> Dom Type -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dom Type -> Type
forall t e. Dom' t e -> e
unDom (Dom Type -> Term)
-> NamesT (TCMT IO) (Dom Type) -> NamesT (TCMT IO) Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamesT (TCMT IO) Term -> NamesT (TCMT IO) (Dom Type)
ty NamesT (TCMT IO) Term
i)
                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
<@> (Abs Term -> Term -> Term
Abs Term -> SubstArg Term -> Term
forall a. Subst a => Abs a -> SubstArg a -> a
lazyAbsApp (Abs Term -> Term -> Term)
-> NamesT (TCMT IO) (Abs Term) -> NamesT (TCMT IO) (Term -> Term)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamesT (TCMT IO) (Abs Term)
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
<*> NamesT (TCMT IO) Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primIZero)

  String -> Int -> TCMT IO Doc -> TCMT IO ()
forall (m :: * -> *).
MonadDebug m =>
String -> Int -> TCMT IO Doc -> m ()
reportSDoc String
"tc.cover.conid" Int
20 (TCMT IO Doc -> TCMT IO ()) -> TCMT IO Doc -> TCMT IO ()
forall a b. (a -> b) -> a -> b
$ String -> TCMT IO Doc
forall (m :: * -> *). Applicative m => String -> m Doc
text String
"conid case for" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> String -> TCMT IO Doc
forall (m :: * -> *). Applicative m => String -> m Doc
text (QName -> String
forall a. Show a => a -> String
show QName
f)
  String -> Int -> TCMT IO Doc -> TCMT IO ()
forall (m :: * -> *).
MonadDebug m =>
String -> Int -> TCMT IO Doc -> m ()
reportSDoc String
"tc.cover.conid" Int
20 (TCMT IO Doc -> TCMT IO ()) -> TCMT IO Doc -> TCMT IO ()
forall a b. (a -> b) -> a -> b
$ String -> TCMT IO Doc
forall (m :: * -> *). Applicative m => String -> m Doc
text String
"tel =" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> Telescope -> TCMT IO Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
forall (m :: * -> *). MonadPretty m => Telescope -> m Doc
prettyTCM Telescope
working_tel
  String -> Int -> TCMT IO Doc -> TCMT IO ()
forall (m :: * -> *).
MonadDebug m =>
String -> Int -> TCMT IO Doc -> m ()
reportSDoc String
"tc.cover.conid" Int
25 (TCMT IO Doc -> TCMT IO ()) -> TCMT IO Doc -> TCMT IO ()
forall a b. (a -> b) -> a -> b
$ Telescope -> TCMT IO Doc -> TCMT IO Doc
forall b (m :: * -> *) a.
(AddContext b, MonadAddContext m) =>
b -> m a -> m a
forall (m :: * -> *) a.
MonadAddContext m =>
Telescope -> m a -> m a
addContext Telescope
working_tel (TCMT IO Doc -> TCMT IO Doc) -> TCMT IO Doc -> TCMT IO Doc
forall a b. (a -> b) -> a -> b
$ Term -> TCMT IO Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
forall (m :: * -> *). MonadPretty m => Term -> m Doc
prettyTCM Term
rhs

  let cl :: Clause
cl =   Clause { clauseLHSRange :: Range
clauseLHSRange  = Range
forall a. Range' a
noRange
                    , clauseFullRange :: Range
clauseFullRange = Range
forall a. Range' a
noRange
                    , clauseTel :: Telescope
clauseTel       = Telescope
working_tel
                    , namedClausePats :: [NamedArg DeBruijnPattern]
namedClausePats = [NamedArg DeBruijnPattern]
ps
                    , clauseBody :: Maybe Term
clauseBody      = Term -> Maybe Term
forall a. a -> Maybe a
Just (Term -> Maybe Term) -> Term -> Maybe Term
forall a b. (a -> b) -> a -> b
$ Term
rhs
                    , clauseType :: Maybe (Arg Type)
clauseType      = Arg Type -> Maybe (Arg Type)
forall a. a -> Maybe a
Just (Arg Type -> Maybe (Arg Type)) -> Arg Type -> Maybe (Arg Type)
forall a b. (a -> b) -> a -> b
$ ArgInfo -> Type -> Arg Type
forall e. ArgInfo -> e -> Arg e
Arg (Dom Type -> ArgInfo
forall t e. Dom' t e -> ArgInfo
domInfo Dom Type
ty) (Dom Type -> Type
forall t e. Dom' t e -> e
unDom Dom Type
ty)
                    , clauseCatchall :: Bool
clauseCatchall    = Bool
False
                    , clauseUnreachable :: Maybe Bool
clauseUnreachable = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False  -- missing, thus, not unreachable
                    , clauseRecursive :: Maybe Bool
clauseRecursive   = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False
                    , clauseEllipsis :: ExpandedEllipsis
clauseEllipsis    = ExpandedEllipsis
NoEllipsis
                    , clauseExact :: Maybe Bool
clauseExact       = Maybe Bool
forall a. Maybe a
Nothing
                    , clauseWhereModule :: Maybe ModuleName
clauseWhereModule = Maybe ModuleName
forall a. Maybe a
Nothing
                    }
  QName -> [Clause] -> TCMT IO ()
forall (m :: * -> *).
(MonadConstraint m, MonadTCState m) =>
QName -> [Clause] -> m ()
addClauses QName
f [Clause
cl]
  Maybe ((SplitTag, SplitTree' SplitTag), Clause)
-> TCM (Maybe ((SplitTag, SplitTree' SplitTag), Clause))
forall a. a -> TCMT IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ((SplitTag, SplitTree' SplitTag), Clause)
 -> TCM (Maybe ((SplitTag, SplitTree' SplitTag), Clause)))
-> Maybe ((SplitTag, SplitTree' SplitTag), Clause)
-> TCM (Maybe ((SplitTag, SplitTree' SplitTag), Clause))
forall a b. (a -> b) -> a -> b
$ ((SplitTag, SplitTree' SplitTag), Clause)
-> Maybe ((SplitTag, SplitTree' SplitTag), Clause)
forall a. a -> Maybe a
Just ((QName -> SplitTag
SplitCon QName
conId,Int -> SplitTree' SplitTag
forall a. Int -> SplitTree' a
SplittingDone (Telescope -> Int
forall a. Sized a => a -> Int
size Telescope
working_tel)),Clause
cl)
createMissingConIdClause QName
f Arg Int
n BlockingVar
x SplitClause
old_sc IInfo
NoInfo = Maybe ((SplitTag, SplitTree' SplitTag), Clause)
-> TCM (Maybe ((SplitTag, SplitTree' SplitTag), Clause))
forall a. a -> TCMT IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ((SplitTag, SplitTree' SplitTag), Clause)
forall a. Maybe a
Nothing


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

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

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

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

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

  Term
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
  Term
iz      <- 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
builtinIZero
  let
    cannotCreate :: MonadTCError m => Doc -> Closure (Abs Type) -> m a
    cannotCreate :: forall (m :: * -> *) a.
MonadTCError m =>
Doc -> Closure (Abs Type) -> m a
cannotCreate Doc
doc Closure (Abs Type)
t = do
      TypeError -> m a
forall (m :: * -> *) a.
(HasCallStack, MonadTCError m) =>
TypeError -> m a
typeError (TypeError -> m a)
-> (SplitError -> TypeError) -> SplitError -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SplitError -> TypeError
SplitError (SplitError -> m a) -> SplitError -> m a
forall a b. (a -> b) -> a -> b
$ QName
-> (Telescope, [NamedArg DeBruijnPattern])
-> Doc
-> Closure (Abs Type)
-> SplitError
CannotCreateMissingClause QName
f (Telescope
tel,[NamedArg SplitPattern] -> [NamedArg DeBruijnPattern]
fromSplitPatterns [NamedArg SplitPattern]
ps) Doc
doc Closure (Abs Type)
t
  let old_ps :: [Elim]
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 :: Dom Type
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 :: Telescope
old_tel = SplitClause -> Telescope
scTel SplitClause
old_sc
      -- old_tel = Γ(x:H)Δ
      -- Γ(x:H)Δ ⊢ old_t
      -- vs = iApplyVars old_ps
      -- [ α ⇒ b ] = [(i,f old_ps (i=0),f old_ps (i=1)) | i <- vs]

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

      -- Extra assumption:
      -- tel = Γ,φ,u,u0,Δ(x = hcomp φ u u0),Δ'
      -- ps = old_ps[x = hcomp φ u u0],ps'
      -- with Δ' and ps' introduced by fixTarget.
      -- So final clause will be:
      -- tel ⊢ ps ↦ rhs_we_define{wkS ..} ps'
      getLevel :: a -> m Term
getLevel a
t = do
        Sort
s <- Sort -> m Sort
forall a (m :: * -> *). (Reduce a, MonadReduce m) => a -> m a
reduce (Sort -> m Sort) -> Sort -> m Sort
forall a b. (a -> b) -> a -> b
$ a -> Sort
forall a. LensSort a => a -> Sort
getSort a
t
        case Sort
s of
          Type Level
l -> Term -> m Term
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Level -> Term
Level Level
l)
          Sort
s      -> do
            String -> Int -> TCMT IO Doc -> m ()
forall (m :: * -> *).
MonadDebug m =>
String -> Int -> TCMT IO Doc -> m ()
reportSDoc String
"tc.cover.hcomp" Int
20 (TCMT IO Doc -> m ()) -> TCMT IO Doc -> m ()
forall a b. (a -> b) -> a -> b
$ String -> TCMT IO Doc
forall (m :: * -> *). Applicative m => String -> m Doc
text String
"getLevel, s = " TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> Sort -> TCMT IO Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
forall (m :: * -> *). MonadPretty m => Sort -> m Doc
prettyTCM Sort
s
            TypeError -> m Term
forall (m :: * -> *) a.
(HasCallStack, MonadTCError m) =>
TypeError -> m a
typeError (TypeError -> m Term) -> (Doc -> TypeError) -> Doc -> m Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> TypeError
GenericDocError (Doc -> m Term) -> m Doc -> m Term
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
                    (String -> m Doc
forall (m :: * -> *). Applicative m => String -> m Doc
text String
"The sort of" m Doc -> m Doc -> m Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> a -> m Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
forall (m :: * -> *). MonadPretty m => a -> m Doc
prettyTCM a
t m Doc -> m Doc -> m Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> String -> m Doc
forall (m :: * -> *). Applicative m => String -> m Doc
text String
"should be of the form \"Set l\"")

      -- Γ ⊢ hdelta = (x : H)(δ : Δ)
      (Telescope
gamma,hdelta :: Telescope
hdelta@(ExtendTel Dom Type
hdom Abs Telescope
delta)) = Int -> Telescope -> (Telescope, Telescope)
splitTelescopeAt (Telescope -> Int
forall a. Sized a => a -> Int
size Telescope
old_tel Int -> Int -> Int
forall a. Num a => a -> a -> a
- (BlockingVar -> Int
blockingVarNo BlockingVar
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)) Telescope
old_tel

      -- Γ,φ,u,u0,Δ(x = hcomp φ u u0) ⊢
      (Telescope
working_tel,Telescope
_deltaEx) = Int -> Telescope -> (Telescope, Telescope)
splitTelescopeAt (Telescope -> Int
forall a. Sized a => a -> Int
size Telescope
gamma Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Abs Telescope -> Int
forall a. Sized a => a -> Int
size Abs Telescope
delta) Telescope
tel

      -- Γ,φ,u,u0,(x:H)(δ : Δ) ⊢ rhoS : Γ(x:H)(δ : Δ)
      {- rhoS = liftS (size hdelta) $ raiseS 3 -}
      vs :: [Int]
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]
  [(Term, (Term, Term))]
alphab <- [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
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
               (Term
l,Term
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)
               (Term, (Term, Term)) -> TCMT IO (Term, (Term, Term))
forall a. a -> TCMT IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Term, (Term, Term)) -> TCMT IO (Term, (Term, Term)))
-> (Term, (Term, Term)) -> TCMT IO (Term, (Term, Term))
forall a b. (a -> b) -> a -> b
$ (Int -> Term
var Int
i, (Term
l, Term
r))



  Clause
cl <- do
    (Type
ty,Term
rhs) <- Telescope -> TCMT IO (Type, Term) -> TCMT IO (Type, Term)
forall b (m :: * -> *) a.
(AddContext b, MonadAddContext m) =>
b -> m a -> m a
forall (m :: * -> *) a.
MonadAddContext m =>
Telescope -> m a -> m a
addContext Telescope
working_tel (TCMT IO (Type, Term) -> TCMT IO (Type, Term))
-> TCMT IO (Type, Term) -> TCMT IO (Type, Term)
forall a b. (a -> b) -> a -> b
$ 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,δ]

      [String] -> NamesT (TCMT IO) (Type, Term) -> TCMT IO (Type, Term)
forall (m :: * -> *) a. [String] -> NamesT m a -> m a
runNamesT [] (NamesT (TCMT IO) (Type, Term) -> TCMT IO (Type, Term))
-> NamesT (TCMT IO) (Type, Term) -> TCMT IO (Type, Term)
forall a b. (a -> b) -> a -> b
$ do
          Term
tPOr <- Term -> Maybe Term -> Term
forall a. a -> Maybe a -> a
fromMaybe Term
forall a. HasCallStack => a
__IMPOSSIBLE__ (Maybe Term -> Term)
-> NamesT (TCMT IO) (Maybe Term) -> NamesT (TCMT IO) Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PrimitiveId -> NamesT (TCMT IO) (Maybe Term)
forall (m :: * -> *) a.
(HasBuiltins m, IsBuiltin a) =>
a -> m (Maybe Term)
getTerm' PrimitiveId
builtinPOr
          Term
tIMax <- Term -> Maybe Term -> Term
forall a. a -> Maybe a -> a
fromMaybe Term
forall a. HasCallStack => a
__IMPOSSIBLE__ (Maybe Term -> Term)
-> NamesT (TCMT IO) (Maybe Term) -> NamesT (TCMT IO) Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PrimitiveId -> NamesT (TCMT IO) (Maybe Term)
forall (m :: * -> *) a.
(HasBuiltins m, IsBuiltin a) =>
a -> m (Maybe Term)
getTerm' PrimitiveId
builtinIMax
          Term
tIMin <- Term -> Maybe Term -> Term
forall a. a -> Maybe a -> a
fromMaybe Term
forall a. HasCallStack => a
__IMPOSSIBLE__ (Maybe Term -> Term)
-> NamesT (TCMT IO) (Maybe Term) -> NamesT (TCMT IO) Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PrimitiveId -> NamesT (TCMT IO) (Maybe Term)
forall (m :: * -> *) a.
(HasBuiltins m, IsBuiltin a) =>
a -> m (Maybe Term)
getTerm' PrimitiveId
builtinIMin
          Term
tINeg <- Term -> Maybe Term -> Term
forall a. a -> Maybe a -> a
fromMaybe Term
forall a. HasCallStack => a
__IMPOSSIBLE__ (Maybe Term -> Term)
-> NamesT (TCMT IO) (Maybe Term) -> NamesT (TCMT IO) Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PrimitiveId -> NamesT (TCMT IO) (Maybe Term)
forall (m :: * -> *) a.
(HasBuiltins m, IsBuiltin a) =>
a -> m (Maybe Term)
getTerm' PrimitiveId
builtinINeg
          Term
tHComp <- Term -> Maybe Term -> Term
forall a. a -> Maybe a -> a
fromMaybe Term
forall a. HasCallStack => a
__IMPOSSIBLE__ (Maybe Term -> Term)
-> NamesT (TCMT IO) (Maybe Term) -> NamesT (TCMT IO) Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PrimitiveId -> NamesT (TCMT IO) (Maybe Term)
forall (m :: * -> *) a.
(HasBuiltins m, IsBuiltin a) =>
a -> m (Maybe Term)
getTerm' PrimitiveId
builtinHComp
          Term
tTrans <- Term -> Maybe Term -> Term
forall a. a -> Maybe a -> a
fromMaybe Term
forall a. HasCallStack => a
__IMPOSSIBLE__ (Maybe Term -> Term)
-> NamesT (TCMT IO) (Maybe Term) -> NamesT (TCMT IO) Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PrimitiveId -> NamesT (TCMT IO) (Maybe Term)
forall (m :: * -> *) a.
(HasBuiltins m, IsBuiltin a) =>
a -> m (Maybe Term)
getTerm' PrimitiveId
builtinTrans
          NamesT (TCMT IO) [Elim]
extra_ps <- [Elim] -> NamesT (TCMT IO) (NamesT (TCMT IO) [Elim])
forall (m :: * -> *) a.
(MonadFail m, Subst a) =>
a -> NamesT m (NamesT m a)
open ([Elim] -> NamesT (TCMT IO) (NamesT (TCMT IO) [Elim]))
-> [Elim] -> NamesT (TCMT IO) (NamesT (TCMT IO) [Elim])
forall a b. (a -> b) -> a -> b
$ [NamedArg DeBruijnPattern] -> [Elim]
patternsToElims ([NamedArg DeBruijnPattern] -> [Elim])
-> [NamedArg DeBruijnPattern] -> [Elim]
forall a b. (a -> b) -> a -> b
$ [NamedArg SplitPattern] -> [NamedArg DeBruijnPattern]
fromSplitPatterns ([NamedArg SplitPattern] -> [NamedArg DeBruijnPattern])
-> [NamedArg SplitPattern] -> [NamedArg DeBruijnPattern]
forall a b. (a -> b) -> a -> b
$ Int -> [NamedArg SplitPattern] -> [NamedArg SplitPattern]
forall a. Int -> [a] -> [a]
drop ([Elim] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Elim]
old_ps) [NamedArg SplitPattern]
ps
          let
            ineg :: NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
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
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
imax NamesT (TCMT IO) Term
i NamesT (TCMT IO) Term
j = Term -> NamesT (TCMT IO) Term
forall a. a -> NamesT (TCMT IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
tIMax NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT (TCMT IO) Term
i NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT (TCMT IO) Term
j
            trFillTel' :: t (TCMT IO) (Abs Telescope)
-> t (TCMT IO) Term
-> t (TCMT IO) Args
-> t (TCMT IO) Term
-> t (TCMT IO) Args
trFillTel' t (TCMT IO) (Abs Telescope)
a t (TCMT IO) Term
b t (TCMT IO) Args
c t (TCMT IO) Term
d = do
              ExceptT (Closure (Abs Type)) (TCMT IO) Args
m <- Abs Telescope
-> Term
-> Args
-> Term
-> ExceptT (Closure (Abs Type)) (TCMT IO) Args
trFillTel (Abs Telescope
 -> Term
 -> Args
 -> Term
 -> ExceptT (Closure (Abs Type)) (TCMT IO) Args)
-> t (TCMT IO) (Abs Telescope)
-> t (TCMT IO)
     (Term
      -> Args -> Term -> ExceptT (Closure (Abs Type)) (TCMT IO) Args)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> t (TCMT IO) (Abs Telescope)
a t (TCMT IO)
  (Term
   -> Args -> Term -> ExceptT (Closure (Abs Type)) (TCMT IO) Args)
-> t (TCMT IO) Term
-> t (TCMT IO)
     (Args -> Term -> ExceptT (Closure (Abs Type)) (TCMT IO) Args)
forall a b. t (TCMT IO) (a -> b) -> t (TCMT IO) a -> t (TCMT IO) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> t (TCMT IO) Term
b t (TCMT IO)
  (Args -> Term -> ExceptT (Closure (Abs Type)) (TCMT IO) Args)
-> t (TCMT IO) Args
-> t (TCMT IO)
     (Term -> ExceptT (Closure (Abs Type)) (TCMT IO) Args)
forall a b. t (TCMT IO) (a -> b) -> t (TCMT IO) a -> t (TCMT IO) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> t (TCMT IO) Args
c t (TCMT IO) (Term -> ExceptT (Closure (Abs Type)) (TCMT IO) Args)
-> t (TCMT IO) Term
-> t (TCMT IO) (ExceptT (Closure (Abs Type)) (TCMT IO) Args)
forall a b. t (TCMT IO) (a -> b) -> t (TCMT IO) a -> t (TCMT IO) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> t (TCMT IO) Term
d
              Either (Closure (Abs Type)) Args
x <- TCM (Either (Closure (Abs Type)) Args)
-> t (TCMT IO) (Either (Closure (Abs Type)) Args)
forall (m :: * -> *) a. Monad m => m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (TCM (Either (Closure (Abs Type)) Args)
 -> t (TCMT IO) (Either (Closure (Abs Type)) Args))
-> TCM (Either (Closure (Abs Type)) Args)
-> t (TCMT IO) (Either (Closure (Abs Type)) Args)
forall a b. (a -> b) -> a -> b
$ ExceptT (Closure (Abs Type)) (TCMT IO) Args
-> TCM (Either (Closure (Abs Type)) Args)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT ExceptT (Closure (Abs Type)) (TCMT IO) Args
m
              case Either (Closure (Abs Type)) Args
x of
                Left Closure (Abs Type)
bad_t -> Doc -> Closure (Abs Type) -> t (TCMT IO) Args
forall (m :: * -> *) a.
MonadTCError m =>
Doc -> Closure (Abs Type) -> m a
cannotCreate Doc
"Cannot transport with type family:" Closure (Abs Type)
bad_t
                Right Args
args -> Args -> t (TCMT IO) Args
forall a. a -> t (TCMT IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return Args
args
          NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term
comp <- String
-> NamesT
     (TCMT IO)
     (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 (m :: * -> *).
HasBuiltins m =>
String
-> NamesT
     m
     (NamesT m Term
      -> NamesT m Term
      -> NamesT m Term
      -> NamesT m Term
      -> NamesT m Term
      -> NamesT m Term)
mkCompLazy String
"hcompClause"
          let
            hcomp :: 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 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
-> 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
la NamesT (TCMT IO) Term
bA NamesT (TCMT IO) Term
phi NamesT (TCMT IO) Term
u NamesT (TCMT IO) Term
u0 NamesT (TCMT IO) Term
i = NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term
hcomp NamesT (TCMT IO) Term
la NamesT (TCMT IO) Term
bA
                                               (Term -> NamesT (TCMT IO) Term
forall a. a -> NamesT (TCMT IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
tIMax NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT (TCMT IO) Term
phi NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> (Term -> NamesT (TCMT IO) Term
forall a. a -> NamesT (TCMT IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
tINeg NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT (TCMT IO) Term
i))
                                               (String
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
lam String
"j" ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
 -> NamesT (TCMT IO) Term)
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall a b. (a -> b) -> a -> b
$ \ NamesT (TCMT IO) Term
j -> Term -> NamesT (TCMT IO) Term
forall a. a -> NamesT (TCMT IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
tPOr NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> NamesT (TCMT IO) Term
la NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT (TCMT IO) Term
phi NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> (Term -> NamesT (TCMT IO) Term
forall a. a -> NamesT (TCMT IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
tINeg NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT (TCMT IO) Term
i) NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> String
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
ilam String
"o" (\ NamesT (TCMT IO) Term
_ -> NamesT (TCMT IO) Term
bA)
                                                     NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> String
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
ilam String
"o" (\ NamesT (TCMT IO) Term
o -> NamesT (TCMT IO) Term
u NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> (Term -> NamesT (TCMT IO) Term
forall a. a -> NamesT (TCMT IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
tIMin NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT (TCMT IO) Term
i NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT (TCMT IO) Term
j) NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<..> NamesT (TCMT IO) Term
o)
                                                     NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> String
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
ilam String
"o" (\ NamesT (TCMT IO) Term
_ -> NamesT (TCMT IO) Term
u0)
                                                   )
                                               NamesT (TCMT IO) Term
u0
          -- Γ,φ,u,u0,(δ : Δ(x = hcomp φ u u0)) ⊢ hcompS : Γ(x:H)(δ : Δ)
          Substitution' Term
hcompS <- TCMT IO (Substitution' Term)
-> NamesT (TCMT IO) (Substitution' Term)
forall (m :: * -> *) a. Monad m => m a -> NamesT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (TCMT IO (Substitution' Term)
 -> NamesT (TCMT IO) (Substitution' Term))
-> TCMT IO (Substitution' Term)
-> NamesT (TCMT IO) (Substitution' Term)
forall a b. (a -> b) -> a -> b
$ do
            Dom Type
hdom <- Dom Type -> TCMT IO (Dom Type)
forall a. a -> TCMT IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Dom Type -> TCMT IO (Dom Type)) -> Dom Type -> TCMT IO (Dom Type)
forall a b. (a -> b) -> a -> b
$ Int -> Dom Type -> Dom Type
forall a. Subst a => Int -> a -> a
raise Int
3 Dom Type
hdom
            let
              [TCMT IO Term
phi,TCMT IO Term
u,TCMT IO Term
u0] = (Int -> TCMT IO Term) -> [Int] -> [TCMT IO Term]
forall a b. (a -> b) -> [a] -> [b]
map (Term -> TCMT IO Term
forall a. a -> TCMT IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term -> TCMT IO Term) -> (Int -> Term) -> Int -> TCMT IO Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Term
var) [Int
2,Int
1,Int
0]
              htype :: TCMT IO Term
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 :: TCMT IO Term
lvl = Type -> TCMT IO Term
forall {m :: * -> *} {a}.
(LensSort a, MonadError TCErr m, PrettyTCM a, MonadFresh NameId m,
 MonadInteractionPoints m, MonadStConcreteNames m, PureTCM m,
 IsString (m Doc), Null (m Doc), Semigroup (m Doc)) =>
a -> m Term
getLevel (Type -> TCMT IO Term) -> Type -> TCMT IO Term
forall a b. (a -> b) -> a -> b
$ Dom Type -> Type
forall t e. Dom' t e -> e
unDom Dom Type
hdom
            Term
hc <- Term -> TCMT IO Term
forall a. a -> TCMT IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
tHComp TCMT IO Term -> TCMT IO Term -> TCMT IO Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> TCMT IO Term
lvl TCMT IO Term -> TCMT IO Term -> TCMT IO Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> TCMT IO Term
htype
                                      TCMT IO Term -> TCMT IO Term -> TCMT IO Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> TCMT IO Term
phi
                                      TCMT IO Term -> TCMT IO Term -> TCMT IO Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> TCMT IO Term
u
                                      TCMT IO Term -> TCMT IO Term -> TCMT IO Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> TCMT IO Term
u0
            Substitution' Term -> TCMT IO (Substitution' Term)
forall a. a -> TCMT IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Substitution' Term -> TCMT IO (Substitution' Term))
-> Substitution' Term -> TCMT IO (Substitution' Term)
forall a b. (a -> b) -> a -> b
$ Int -> Substitution' Term -> Substitution' Term
forall a. Int -> Substitution' a -> Substitution' a
liftS (Abs Telescope -> Int
forall a. Sized a => a -> Int
size Abs Telescope
delta) (Substitution' Term -> Substitution' Term)
-> Substitution' Term -> Substitution' Term
forall a b. (a -> b) -> a -> b
$ Term
hc Term -> Substitution' Term -> Substitution' Term
forall a. DeBruijn a => a -> Substitution' a -> Substitution' a
`consS` Int -> Substitution' Term
forall a. Int -> Substitution' a
raiseS Int
3
          -- Γ,φ,u,u0,Δ(x = hcomp phi u u0) ⊢ raise 3+|Δ| hdom
          Dom Type
hdom <- Dom Type -> NamesT (TCMT IO) (Dom Type)
forall a. a -> NamesT (TCMT IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Dom Type -> NamesT (TCMT IO) (Dom Type))
-> Dom Type -> NamesT (TCMT IO) (Dom Type)
forall a b. (a -> b) -> a -> b
$ Int -> Dom Type -> Dom Type
forall a. Subst a => Int -> a -> a
raise (Int
3 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Abs Telescope -> Int
forall a. Sized a => a -> Int
size Abs Telescope
delta) Dom Type
hdom
          NamesT (TCMT IO) Term
htype <- Term -> NamesT (TCMT IO) (NamesT (TCMT IO) Term)
forall (m :: * -> *) a.
(MonadFail m, Subst a) =>
a -> NamesT m (NamesT m a)
open (Term -> NamesT (TCMT IO) (NamesT (TCMT IO) Term))
-> Term -> NamesT (TCMT IO) (NamesT (TCMT IO) Term)
forall a b. (a -> b) -> a -> b
$ 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
          NamesT (TCMT IO) Term
lvl <- Term -> NamesT (TCMT IO) (NamesT (TCMT IO) Term)
forall (m :: * -> *) a.
(MonadFail m, Subst a) =>
a -> NamesT m (NamesT m a)
open (Term -> NamesT (TCMT IO) (NamesT (TCMT IO) Term))
-> NamesT (TCMT IO) Term
-> NamesT (TCMT IO) (NamesT (TCMT IO) Term)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (TCMT IO Term -> NamesT (TCMT IO) Term
forall (m :: * -> *) a. Monad m => m a -> NamesT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (TCMT IO Term -> NamesT (TCMT IO) Term)
-> (Type -> TCMT IO Term) -> Type -> NamesT (TCMT IO) Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type -> TCMT IO Term
forall {m :: * -> *} {a}.
(LensSort a, MonadError TCErr m, PrettyTCM a, MonadFresh NameId m,
 MonadInteractionPoints m, MonadStConcreteNames m, PureTCM m,
 IsString (m Doc), Null (m Doc), Semigroup (m Doc)) =>
a -> m Term
getLevel (Type -> NamesT (TCMT IO) Term) -> Type -> NamesT (TCMT IO) Term
forall a b. (a -> b) -> a -> b
$ Dom Type -> Type
forall t e. Dom' t e -> e
unDom Dom Type
hdom)

          -- Γ,φ,u,u0,Δ(x = hcomp phi u u0) ⊢
          [NamesT (TCMT IO) Term
phi,NamesT (TCMT IO) Term
u,NamesT (TCMT IO) Term
u0] <- (Int -> NamesT (TCMT IO) (NamesT (TCMT IO) Term))
-> [Int] -> NamesT (TCMT IO) [NamesT (TCMT IO) Term]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Term -> NamesT (TCMT IO) (NamesT (TCMT IO) Term)
forall (m :: * -> *) a.
(MonadFail m, Subst a) =>
a -> NamesT m (NamesT m a)
open (Term -> NamesT (TCMT IO) (NamesT (TCMT IO) Term))
-> (Int -> Term) -> Int -> NamesT (TCMT IO) (NamesT (TCMT IO) Term)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Term -> Term
forall a. Subst a => Int -> a -> a
raise (Abs Telescope -> Int
forall a. Sized a => a -> Int
size Abs Telescope
delta) (Term -> Term) -> (Int -> Term) -> Int -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Term
var) [Int
2,Int
1,Int
0]
          -- Γ,x,Δ ⊢ f old_ps
          -- Γ ⊢ abstract hdelta (f old_ps)
          NamesT (TCMT IO) Term
g <- Term -> NamesT (TCMT IO) (NamesT (TCMT IO) Term)
forall (m :: * -> *) a.
(MonadFail m, Subst a) =>
a -> NamesT m (NamesT m a)
open (Term -> NamesT (TCMT IO) (NamesT (TCMT IO) Term))
-> Term -> NamesT (TCMT IO) (NamesT (TCMT IO) Term)
forall a b. (a -> b) -> a -> b
$ Int -> Term -> Term
forall a. Subst a => Int -> a -> a
raise (Int
3 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Abs Telescope -> Int
forall a. Sized a => a -> Int
size Abs Telescope
delta) (Term -> Term) -> Term -> Term
forall a b. (a -> b) -> a -> b
$ Telescope -> Term -> Term
forall t. Abstract t => Telescope -> t -> t
abstract Telescope
hdelta (QName -> [Elim] -> Term
Def QName
f [Elim]
old_ps)
          NamesT (TCMT IO) Type
old_t <- Type -> NamesT (TCMT IO) (NamesT (TCMT IO) Type)
forall (m :: * -> *) a.
(MonadFail m, Subst a) =>
a -> NamesT m (NamesT m a)
open (Type -> NamesT (TCMT IO) (NamesT (TCMT IO) Type))
-> Type -> NamesT (TCMT IO) (NamesT (TCMT IO) Type)
forall a b. (a -> b) -> a -> b
$ Int -> Type -> Type
forall a. Subst a => Int -> a -> a
raise (Int
3 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Abs Telescope -> Int
forall a. Sized a => a -> Int
size Abs Telescope
delta) (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Telescope -> Type -> Type
forall t. Abstract t => Telescope -> t -> t
abstract Telescope
hdelta (Dom Type -> Type
forall t e. Dom' t e -> e
unDom Dom Type
old_t)
          let bapp :: f (Abs b) -> f (SubstArg b) -> f b
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
          (NamesT (TCMT IO) (Abs Args)
delta_fill :: NamesT TCM (Abs Args)) <- (Abs Args -> NamesT (TCMT IO) (NamesT (TCMT IO) (Abs Args))
forall (m :: * -> *) a.
(MonadFail m, Subst a) =>
a -> NamesT m (NamesT m a)
open (Abs Args -> NamesT (TCMT IO) (NamesT (TCMT IO) (Abs Args)))
-> NamesT (TCMT IO) (Abs Args)
-> NamesT (TCMT IO) (NamesT (TCMT IO) (Abs Args))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (NamesT (TCMT IO) (Abs Args)
 -> NamesT (TCMT IO) (NamesT (TCMT IO) (Abs Args)))
-> NamesT (TCMT IO) (Abs Args)
-> NamesT (TCMT IO) (NamesT (TCMT IO) (Abs Args))
forall a b. (a -> b) -> a -> b
$ do
            -- Γ,φ,u,u0,Δ(x = hcomp phi u u0) ⊢ x.Δ
            NamesT (TCMT IO) (Abs Telescope)
delta <- Abs Telescope
-> NamesT (TCMT IO) (NamesT (TCMT IO) (Abs Telescope))
forall (m :: * -> *) a.
(MonadFail m, Subst a) =>
a -> NamesT m (NamesT m a)
open (Abs Telescope
 -> NamesT (TCMT IO) (NamesT (TCMT IO) (Abs Telescope)))
-> Abs Telescope
-> NamesT (TCMT IO) (NamesT (TCMT IO) (Abs Telescope))
forall a b. (a -> b) -> a -> b
$ Int -> Abs Telescope -> Abs Telescope
forall a. Subst a => Int -> a -> a
raise (Int
3 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Abs Telescope -> Int
forall a. Sized a => a -> Int
size Abs Telescope
delta) Abs Telescope
delta
            -- Γ,φ,u,u0,Δ(x = hcomp phi u u0) ⊢ i.Δ(x = hfill phi u u0 (~ i))
            NamesT (TCMT IO) (Abs Telescope)
deltaf <- Abs Telescope
-> NamesT (TCMT IO) (NamesT (TCMT IO) (Abs Telescope))
forall (m :: * -> *) a.
(MonadFail m, Subst a) =>
a -> NamesT m (NamesT m a)
open (Abs Telescope
 -> NamesT (TCMT IO) (NamesT (TCMT IO) (Abs Telescope)))
-> NamesT (TCMT IO) (Abs Telescope)
-> NamesT (TCMT IO) (NamesT (TCMT IO) (Abs Telescope))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String
-> (Var (TCMT IO) -> NamesT (TCMT IO) Telescope)
-> NamesT (TCMT IO) (Abs Telescope)
forall (m :: * -> *) a.
MonadFail m =>
String
-> ((forall b. (Subst b, DeBruijn b) => NamesT m b) -> NamesT m a)
-> NamesT m (Abs a)
bind String
"i" (\ Var (TCMT IO)
i ->
                           (NamesT (TCMT IO) (Abs Telescope)
delta NamesT (TCMT IO) (Abs Telescope)
-> NamesT (TCMT IO) (SubstArg Telescope)
-> NamesT (TCMT IO) Telescope
forall {f :: * -> *} {b}.
(Applicative f, Subst b) =>
f (Abs b) -> f (SubstArg b) -> f b
`bapp` NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term
hfill NamesT (TCMT IO) Term
lvl NamesT (TCMT IO) Term
htype NamesT (TCMT IO) Term
phi NamesT (TCMT IO) Term
u NamesT (TCMT IO) Term
u0 (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
ineg NamesT (TCMT IO) Term
Var (TCMT IO)
i)))
            -- Γ,φ,u,u0,Δ(x = hcomp phi u u0) ⊢ Δ(x = hcomp phi u u0) = Δf[0]
            NamesT (TCMT IO) Args
args <- (Args -> NamesT (TCMT IO) (NamesT (TCMT IO) Args)
forall (m :: * -> *) a.
(MonadFail m, Subst a) =>
a -> NamesT m (NamesT m a)
open (Args -> NamesT (TCMT IO) (NamesT (TCMT IO) Args))
-> NamesT (TCMT IO) Args
-> NamesT (TCMT IO) (NamesT (TCMT IO) Args)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (NamesT (TCMT IO) Args -> NamesT (TCMT IO) (NamesT (TCMT IO) Args))
-> NamesT (TCMT IO) Args
-> NamesT (TCMT IO) (NamesT (TCMT IO) Args)
forall a b. (a -> b) -> a -> b
$ Telescope -> Args
forall a t. DeBruijn a => Tele (Dom t) -> [Arg a]
teleArgs (Telescope -> Args)
-> NamesT (TCMT IO) Telescope -> NamesT (TCMT IO) Args
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Abs Telescope -> Term -> Telescope
Abs Telescope -> SubstArg Telescope -> Telescope
forall a. Subst a => Abs a -> SubstArg a -> a
lazyAbsApp (Abs Telescope -> Term -> Telescope)
-> NamesT (TCMT IO) (Abs Telescope)
-> NamesT (TCMT IO) (Term -> Telescope)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamesT (TCMT IO) (Abs Telescope)
deltaf NamesT (TCMT IO) (Term -> Telescope)
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Telescope
forall a b.
NamesT (TCMT IO) (a -> b)
-> NamesT (TCMT IO) a -> NamesT (TCMT IO) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Term -> NamesT (TCMT IO) Term
forall a. a -> NamesT (TCMT IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
iz)
            String
-> (Var (TCMT IO) -> NamesT (TCMT IO) Args)
-> NamesT (TCMT IO) (Abs Args)
forall (m :: * -> *) a.
MonadFail m =>
String
-> ((forall b. (Subst b, DeBruijn b) => NamesT m b) -> NamesT m a)
-> NamesT m (Abs a)
bind String
"i" ((Var (TCMT IO) -> NamesT (TCMT IO) Args)
 -> NamesT (TCMT IO) (Abs Args))
-> (Var (TCMT IO) -> NamesT (TCMT IO) Args)
-> NamesT (TCMT IO) (Abs Args)
forall a b. (a -> b) -> a -> b
$ \ Var (TCMT IO)
i -> String -> NamesT (TCMT IO) Args -> NamesT (TCMT IO) Args
forall b (m :: * -> *) a.
(AddContext b, MonadAddContext m) =>
b -> m a -> m a
forall (m :: * -> *) a. MonadAddContext m => String -> m a -> m a
addContext (String
"i" :: String) (NamesT (TCMT IO) Args -> NamesT (TCMT IO) Args)
-> NamesT (TCMT IO) Args -> NamesT (TCMT IO) Args
forall a b. (a -> b) -> a -> b
$ do -- for error messages.
              -- Γ,φ,u,u0,Δ(x = hcomp phi u u0),(i:I) ⊢ ... : Δ(x = hfill phi u u0 i)
              NamesT (TCMT IO) (Abs Telescope)
-> NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Args
-> NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Args
forall {t :: (* -> *) -> * -> *}.
(MonadTrans t, MonadTCEnv (t (TCMT IO)), ReadTCState (t (TCMT IO)),
 MonadError TCErr (t (TCMT IO))) =>
t (TCMT IO) (Abs Telescope)
-> t (TCMT IO) Term
-> t (TCMT IO) Args
-> t (TCMT IO) Term
-> t (TCMT IO) Args
trFillTel' NamesT (TCMT IO) (Abs Telescope)
deltaf (Term -> NamesT (TCMT IO) Term
forall a. a -> NamesT (TCMT IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
iz) NamesT (TCMT IO) Args
args (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
ineg NamesT (TCMT IO) Term
Var (TCMT IO)
i)
          let
            apply_delta_fill :: NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
apply_delta_fill NamesT (TCMT IO) Term
i NamesT (TCMT IO) Term
f = Term -> Args -> Term
forall t. Apply t => t -> Args -> t
apply (Term -> Args -> Term)
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) (Args -> Term)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamesT (TCMT IO) Term
f NamesT (TCMT IO) (Args -> Term)
-> NamesT (TCMT IO) Args -> NamesT (TCMT IO) Term
forall a b.
NamesT (TCMT IO) (a -> b)
-> NamesT (TCMT IO) a -> NamesT (TCMT IO) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (NamesT (TCMT IO) (Abs Args)
delta_fill NamesT (TCMT IO) (Abs Args)
-> NamesT (TCMT IO) (SubstArg Args) -> NamesT (TCMT IO) Args
forall {f :: * -> *} {b}.
(Applicative f, Subst b) =>
f (Abs b) -> f (SubstArg b) -> f b
`bapp` NamesT (TCMT IO) Term
NamesT (TCMT IO) (SubstArg Args)
i)
            call :: NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
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
          NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
ty <- do
                (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT
     (TCMT IO) (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
forall a. a -> NamesT (TCMT IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
 -> NamesT
      (TCMT IO) (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type))
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT
     (TCMT IO) (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
forall a b. (a -> b) -> a -> b
$ \ NamesT (TCMT IO) Term
i -> do
                    Term
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
                    Type
hd <- NamesT (TCMT IO) Type
old_t
                    Args
args <- NamesT (TCMT IO) (Abs Args)
delta_fill NamesT (TCMT IO) (Abs Args)
-> NamesT (TCMT IO) (SubstArg Args) -> NamesT (TCMT IO) Args
forall {f :: * -> *} {b}.
(Applicative f, Subst b) =>
f (Abs b) -> f (SubstArg b) -> f b
`bapp` NamesT (TCMT IO) Term
NamesT (TCMT IO) (SubstArg Args)
i
                    TCMT IO Type -> NamesT (TCMT IO) Type
forall (m :: * -> *) a. Monad m => m a -> NamesT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (TCMT IO Type -> NamesT (TCMT IO) Type)
-> TCMT IO Type -> NamesT (TCMT IO) Type
forall a b. (a -> b) -> a -> b
$ Type -> Args -> TCMT IO Type
forall a (m :: * -> *).
(PiApplyM a, MonadReduce m, HasBuiltins m) =>
Type -> a -> m Type
forall (m :: * -> *).
(MonadReduce m, HasBuiltins m) =>
Type -> Args -> m Type
piApplyM Type
hd (Args -> TCMT IO Type) -> Args -> TCMT IO Type
forall a b. (a -> b) -> a -> b
$ ArgInfo -> Term -> Arg Term
forall e. ArgInfo -> e -> Arg e
Arg (Dom Type -> ArgInfo
forall t e. Dom' t e -> ArgInfo
domInfo Dom Type
hdom) Term
v Arg Term -> Args -> Args
forall a. a -> [a] -> [a]
: Args
args
          NamesT (TCMT IO) Term
ty_level <- do
            Abs Type
t <- String
-> (Var (TCMT IO) -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) (Abs Type)
forall (m :: * -> *) a.
MonadFail m =>
String
-> ((forall b. (Subst b, DeBruijn b) => NamesT m b) -> NamesT m a)
-> NamesT m (Abs a)
bind String
"i" ((Var (TCMT IO) -> NamesT (TCMT IO) Type)
 -> NamesT (TCMT IO) (Abs Type))
-> (Var (TCMT IO) -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) (Abs Type)
forall a b. (a -> b) -> a -> b
$ \ Var (TCMT IO)
x -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
ty NamesT (TCMT IO) Term
Var (TCMT IO)
x
            Sort
s <- Sort -> NamesT (TCMT IO) Sort
forall a (m :: * -> *). (Reduce a, MonadReduce m) => a -> m a
reduce (Sort -> NamesT (TCMT IO) Sort) -> Sort -> NamesT (TCMT IO) Sort
forall a b. (a -> b) -> a -> b
$ Type -> Sort
forall a. LensSort a => a -> Sort
getSort (Abs Type -> Type
forall a. Subst a => Abs a -> a
absBody Abs Type
t)
            String -> Int -> TCMT IO Doc -> NamesT (TCMT IO) ()
forall (m :: * -> *).
MonadDebug m =>
String -> Int -> TCMT IO Doc -> m ()
reportSDoc String
"tc.cover.hcomp" Int
20 (TCMT IO Doc -> NamesT (TCMT IO) ())
-> TCMT IO Doc -> NamesT (TCMT IO) ()
forall a b. (a -> b) -> a -> b
$ String -> TCMT IO Doc
forall (m :: * -> *). Applicative m => String -> m Doc
text String
"ty_level, 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
            case Sort
s of
              Type Level
l -> Term -> NamesT (TCMT IO) (NamesT (TCMT IO) Term)
forall (m :: * -> *) a.
(MonadFail m, Subst a) =>
a -> NamesT m (NamesT m a)
open (Term -> NamesT (TCMT IO) (NamesT (TCMT IO) Term))
-> NamesT (TCMT IO) Term
-> NamesT (TCMT IO) (NamesT (TCMT IO) Term)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
lam String
"i" (\ NamesT (TCMT IO) Term
_ -> Term -> NamesT (TCMT IO) Term
forall a. a -> NamesT (TCMT IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term -> NamesT (TCMT IO) Term) -> Term -> NamesT (TCMT IO) Term
forall a b. (a -> b) -> a -> b
$ Level -> Term
Level Level
l)
              Sort
_      -> do Closure (Abs Type)
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)
                           TCM (NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) (NamesT (TCMT IO) Term)
forall a. TCM a -> NamesT (TCMT IO) a
forall (tcm :: * -> *) a. MonadTCM tcm => TCM a -> tcm a
liftTCM (Doc -> Closure (Abs Type) -> TCM (NamesT (TCMT IO) Term)
forall (m :: * -> *) a.
MonadTCError m =>
Doc -> Closure (Abs Type) -> m a
cannotCreate Doc
"Cannot compose with type family:" Closure (Abs Type)
cl)

          let
            pOr_ty :: 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
psi NamesT (TCMT IO) Term
u0 NamesT (TCMT IO) Term
u1 = Term -> NamesT (TCMT IO) Term
forall a. a -> NamesT (TCMT IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
tPOr NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> (NamesT (TCMT IO) Term
ty_level NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT (TCMT IO) Term
i)
                                               NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT (TCMT IO) Term
phi NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT (TCMT IO) Term
psi
                                               NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> String
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
ilam String
"o" (\ NamesT (TCMT IO) Term
_ -> Type -> Term
forall t a. Type'' t a -> a
unEl (Type -> Term) -> NamesT (TCMT IO) Type -> NamesT (TCMT IO) Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
ty NamesT (TCMT IO) Term
i) NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT (TCMT IO) Term
u0 NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT (TCMT IO) Term
u1
          NamesT (TCMT IO) Term
alpha <- do
            [NamesT (TCMT IO) Term]
vars <- ((Term, (Term, Term)) -> NamesT (TCMT IO) (NamesT (TCMT IO) Term))
-> [(Term, (Term, Term))]
-> NamesT (TCMT IO) [NamesT (TCMT IO) Term]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Term -> NamesT (TCMT IO) (NamesT (TCMT IO) Term)
forall (m :: * -> *) a.
(MonadFail m, Subst a) =>
a -> NamesT m (NamesT m a)
open (Term -> NamesT (TCMT IO) (NamesT (TCMT IO) Term))
-> ((Term, (Term, Term)) -> Term)
-> (Term, (Term, Term))
-> NamesT (TCMT IO) (NamesT (TCMT IO) Term)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Substitution' (SubstArg Term) -> Term -> Term
forall a. Subst a => Substitution' (SubstArg a) -> a -> a
applySubst Substitution' Term
Substitution' (SubstArg Term)
hcompS (Term -> Term)
-> ((Term, (Term, Term)) -> Term) -> (Term, (Term, Term)) -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Term, (Term, Term)) -> Term
forall a b. (a, b) -> a
fst) [(Term, (Term, Term))]
alphab
            NamesT (TCMT IO) Term -> NamesT (TCMT IO) (NamesT (TCMT IO) Term)
forall a. a -> NamesT (TCMT IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return (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) 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
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\ 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)) (Term -> NamesT (TCMT IO) Term
forall a. a -> NamesT (TCMT IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
iz) [NamesT (TCMT IO) Term]
vars

          -- Γ,φ,u,u0,Δ(x = hcomp φ u u0) ⊢ b : (i : I) → [α] -> old_t[x = hfill φ u u0 i,δ_fill[i]]
          NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
b <- do
             [(NamesT (TCMT IO) Term,
  NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)]
sides <- [(Term, (Term, Term))]
-> ((Term, (Term, Term))
    -> NamesT
         (TCMT IO)
         (NamesT (TCMT IO) Term,
          NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term))
-> NamesT
     (TCMT IO)
     [(NamesT (TCMT IO) Term,
       NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [(Term, (Term, Term))]
alphab (((Term, (Term, Term))
  -> NamesT
       (TCMT IO)
       (NamesT (TCMT IO) Term,
        NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term))
 -> NamesT
      (TCMT IO)
      [(NamesT (TCMT IO) Term,
        NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)])
-> ((Term, (Term, Term))
    -> NamesT
         (TCMT IO)
         (NamesT (TCMT IO) Term,
          NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term))
-> NamesT
     (TCMT IO)
     [(NamesT (TCMT IO) Term,
       NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)]
forall a b. (a -> b) -> a -> b
$ \ (Term
psi,(Term
side0,Term
side1)) -> do
                NamesT (TCMT IO) Term
psi <- Term -> NamesT (TCMT IO) (NamesT (TCMT IO) Term)
forall (m :: * -> *) a.
(MonadFail m, Subst a) =>
a -> NamesT m (NamesT m a)
open (Term -> NamesT (TCMT IO) (NamesT (TCMT IO) Term))
-> Term -> NamesT (TCMT IO) (NamesT (TCMT IO) Term)
forall a b. (a -> b) -> a -> b
$ Substitution' Term
Substitution' (SubstArg Term)
hcompS Substitution' (SubstArg Term) -> Term -> Term
forall a. Subst a => Substitution' (SubstArg a) -> a -> a
`applySubst` Term
psi

                [NamesT (TCMT IO) Term
side0, NamesT (TCMT IO) Term
side1] <- (Term -> NamesT (TCMT IO) (NamesT (TCMT IO) Term))
-> [Term] -> NamesT (TCMT IO) [NamesT (TCMT IO) Term]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Term -> NamesT (TCMT IO) (NamesT (TCMT IO) Term)
forall (m :: * -> *) a.
(MonadFail m, Subst a) =>
a -> NamesT m (NamesT m a)
open (Term -> NamesT (TCMT IO) (NamesT (TCMT IO) Term))
-> (Term -> Term)
-> Term
-> NamesT (TCMT IO) (NamesT (TCMT IO) Term)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Term -> Term
forall a. Subst a => Int -> a -> a
raise (Int
3 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Abs Telescope -> Int
forall a. Sized a => a -> Int
size Abs Telescope
delta) (Term -> Term) -> (Term -> Term) -> Term -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Telescope -> Term -> Term
forall t. Abstract t => Telescope -> t -> t
abstract Telescope
hdelta) [Term
side0, Term
side1]
                (NamesT (TCMT IO) Term,
 NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT
     (TCMT IO)
     (NamesT (TCMT IO) Term,
      NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
forall a. a -> NamesT (TCMT IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return ((NamesT (TCMT IO) Term,
  NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
 -> NamesT
      (TCMT IO)
      (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)
     (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
ineg NamesT (TCMT IO) Term
psi NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
`imax` NamesT (TCMT IO) Term
psi, \ NamesT (TCMT IO) Term
i -> NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term
pOr_ty NamesT (TCMT IO) Term
i (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
ineg NamesT (TCMT IO) Term
psi) NamesT (TCMT IO) Term
psi (String
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
ilam String
"o" ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
 -> NamesT (TCMT IO) Term)
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall a b. (a -> b) -> a -> b
$ \ NamesT (TCMT IO) Term
_ -> NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
apply_delta_fill NamesT (TCMT IO) Term
i (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall a b. (a -> b) -> a -> b
$ NamesT (TCMT IO) Term
side0 NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term
hfill NamesT (TCMT IO) Term
lvl NamesT (TCMT IO) Term
htype NamesT (TCMT IO) Term
phi NamesT (TCMT IO) Term
u NamesT (TCMT IO) Term
u0 NamesT (TCMT IO) Term
i)
                                                            (String
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
ilam String
"o" ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
 -> NamesT (TCMT IO) Term)
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall a b. (a -> b) -> a -> b
$ \ NamesT (TCMT IO) Term
_ -> NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
apply_delta_fill NamesT (TCMT IO) Term
i (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall a b. (a -> b) -> a -> b
$ NamesT (TCMT IO) Term
side1 NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term
hfill NamesT (TCMT IO) Term
lvl NamesT (TCMT IO) Term
htype NamesT (TCMT IO) Term
phi NamesT (TCMT IO) Term
u NamesT (TCMT IO) Term
u0 NamesT (TCMT IO) Term
i))
             let recurse :: [(NamesT (TCMT IO) Term,
  NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)]
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
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)
             (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT
     (TCMT IO) (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
forall a. a -> NamesT (TCMT IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
 -> NamesT
      (TCMT IO) (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) Term)
forall a b. (a -> b) -> a -> b
$ [(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)]
sides

          ((,) (Type -> Term -> (Type, Term))
-> NamesT (TCMT IO) Type -> NamesT (TCMT IO) (Term -> (Type, Term))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
ty (Term -> NamesT (TCMT IO) Term
forall a. a -> NamesT (TCMT IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
io) NamesT (TCMT IO) (Term -> (Type, Term))
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) (Type, Term)
forall a b.
NamesT (TCMT IO) (a -> b)
-> NamesT (TCMT IO) a -> NamesT (TCMT IO) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>) (NamesT (TCMT IO) Term -> NamesT (TCMT IO) (Type, Term))
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) (Type, Term)
forall a b. (a -> b) -> a -> b
$ 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
comp NamesT (TCMT IO) Term
ty_level
               (String
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
lam String
"i" ((NamesT (TCMT IO) Term -> 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
$ (Type -> Term) -> NamesT (TCMT IO) Type -> 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 Type -> Term
forall t a. Type'' t a -> a
unEl (NamesT (TCMT IO) Type -> NamesT (TCMT IO) Term)
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> 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) Type
ty)
                           (NamesT (TCMT IO) Term
phi NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
`imax` NamesT (TCMT IO) Term
alpha)
                           (String
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
lam String
"i" ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
 -> NamesT (TCMT IO) Term)
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall a b. (a -> b) -> a -> b
$ \ NamesT (TCMT IO) Term
i ->
                               let rhs :: NamesT (TCMT IO) Term
rhs = (String
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
ilam String
"o" ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
 -> NamesT (TCMT IO) Term)
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall a b. (a -> b) -> a -> b
$ \ NamesT (TCMT IO) Term
o -> NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
call (NamesT (TCMT IO) Term
u NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT (TCMT IO) Term
i NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<..> NamesT (TCMT IO) Term
o) NamesT (TCMT IO) Term
i)
                               in if [(Term, (Term, Term))] -> Bool
forall a. Null a => a -> Bool
null [(Term, (Term, Term))]
alphab then NamesT (TCMT IO) Term
rhs else
                                   NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term
pOr_ty NamesT (TCMT IO) Term
i NamesT (TCMT IO) Term
phi NamesT (TCMT IO) Term
alpha NamesT (TCMT IO) Term
rhs (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
b NamesT (TCMT IO) Term
i)
                           )
                           (NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
call 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
iz))
    String -> Int -> TCMT IO Doc -> TCMT IO ()
forall (m :: * -> *).
MonadDebug m =>
String -> Int -> TCMT IO Doc -> m ()
reportSDoc String
"tc.cover.hcomp" Int
20 (TCMT IO Doc -> TCMT IO ()) -> TCMT IO Doc -> TCMT IO ()
forall a b. (a -> b) -> a -> b
$ String -> TCMT IO Doc
forall (m :: * -> *). Applicative m => String -> m Doc
text String
"old_tel =" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> Telescope -> TCMT IO Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
forall (m :: * -> *). MonadPretty m => Telescope -> m Doc
prettyTCM Telescope
tel
    let n :: Int
n = Telescope -> Int
forall a. Sized a => a -> Int
size Telescope
tel Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Telescope -> Int
forall a. Sized a => a -> Int
size Telescope
gamma Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Abs Telescope -> Int
forall a. Sized a => a -> Int
size Abs Telescope
delta)
    String -> Int -> TCMT IO Doc -> TCMT IO ()
forall (m :: * -> *).
MonadDebug m =>
String -> Int -> TCMT IO Doc -> m ()
reportSDoc String
"tc.cover.hcomp" Int
20 (TCMT IO Doc -> TCMT IO ()) -> TCMT IO Doc -> TCMT IO ()
forall a b. (a -> b) -> a -> b
$ String -> TCMT IO Doc
forall (m :: * -> *). Applicative m => String -> m Doc
text String
"n =" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> String -> TCMT IO Doc
forall (m :: * -> *). Applicative m => String -> m Doc
text (Int -> String
forall a. Show a => a -> String
show Int
n)
    (TelV Telescope
deltaEx Type
t,[(Term, (Term, Term))]
bs) <- Int -> Type -> TCMT IO (TelV Type, [(Term, (Term, Term))])
forall (m :: * -> *).
PureTCM m =>
Int -> Type -> m (TelV Type, [(Term, (Term, Term))])
telViewUpToPathBoundary' Int
n Type
ty
    Term
rhs <- 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
$ Int -> Term -> Term
forall a. Subst a => Int -> a -> a
raise Int
n Term
rhs Term -> [Elim] -> Term
forall t. Apply t => t -> [Elim] -> t
`applyE` Telescope -> [(Term, (Term, Term))] -> [Elim]
forall a. DeBruijn a => Telescope -> Boundary' (a, a) -> [Elim' a]
teleElims Telescope
deltaEx [(Term, (Term, Term))]
bs

    Telescope
cxt <- TCMT IO Telescope
forall (m :: * -> *). (Applicative m, MonadTCEnv m) => m Telescope
getContextTelescope
    String -> Int -> TCMT IO Doc -> TCMT IO ()
forall (m :: * -> *).
MonadDebug m =>
String -> Int -> TCMT IO Doc -> m ()
reportSDoc String
"tc.cover.hcomp" Int
30 (TCMT IO Doc -> TCMT IO ()) -> TCMT IO Doc -> TCMT IO ()
forall a b. (a -> b) -> a -> b
$ String -> TCMT IO Doc
forall (m :: * -> *). Applicative m => String -> m Doc
text String
"cxt = " TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> Telescope -> TCMT IO Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
forall (m :: * -> *). MonadPretty m => Telescope -> m Doc
prettyTCM Telescope
cxt
    String -> Int -> TCMT IO Doc -> TCMT IO ()
forall (m :: * -> *).
MonadDebug m =>
String -> Int -> TCMT IO Doc -> m ()
reportSDoc String
"tc.cover.hcomp" Int
30 (TCMT IO Doc -> TCMT IO ()) -> TCMT IO Doc -> TCMT IO ()
forall a b. (a -> b) -> a -> b
$ String -> TCMT IO Doc
forall (m :: * -> *). Applicative m => String -> m Doc
text String
"tel = " TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> Telescope -> TCMT IO Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
forall (m :: * -> *). MonadPretty m => Telescope -> m Doc
prettyTCM Telescope
tel
    String -> Int -> TCMT IO Doc -> TCMT IO ()
forall (m :: * -> *).
MonadDebug m =>
String -> Int -> TCMT IO Doc -> m ()
reportSDoc String
"tc.cover.hcomp" Int
20 (TCMT IO Doc -> TCMT IO ()) -> TCMT IO Doc -> TCMT IO ()
forall a b. (a -> b) -> a -> b
$ Telescope -> TCMT IO Doc -> TCMT IO Doc
forall b (m :: * -> *) a.
(AddContext b, MonadAddContext m) =>
b -> m a -> m a
forall (m :: * -> *) a.
MonadAddContext m =>
Telescope -> m a -> m a
addContext Telescope
tel (TCMT IO Doc -> TCMT IO Doc) -> TCMT IO Doc -> TCMT IO Doc
forall a b. (a -> b) -> a -> b
$ String -> TCMT IO Doc
forall (m :: * -> *). Applicative m => String -> m Doc
text String
"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
    String -> Int -> TCMT IO Doc -> TCMT IO ()
forall (m :: * -> *).
MonadDebug m =>
String -> Int -> TCMT IO Doc -> m ()
reportSDoc String
"tc.cover.hcomp" Int
20 (TCMT IO Doc -> TCMT IO ()) -> TCMT IO Doc -> TCMT IO ()
forall a b. (a -> b) -> a -> b
$ Telescope -> TCMT IO Doc -> TCMT IO Doc
forall b (m :: * -> *) a.
(AddContext b, MonadAddContext m) =>
b -> m a -> m a
forall (m :: * -> *) a.
MonadAddContext m =>
Telescope -> m a -> m a
addContext Telescope
tel (TCMT IO Doc -> TCMT IO Doc) -> TCMT IO Doc -> TCMT IO Doc
forall a b. (a -> b) -> a -> b
$ String -> TCMT IO Doc
forall (m :: * -> *). Applicative m => String -> m Doc
text String
"rhs = " TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> Term -> TCMT IO Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
forall (m :: * -> *). MonadPretty m => Term -> m Doc
prettyTCM Term
rhs

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