{-# LANGUAGE NondecreasingIndentation #-}

module Agda.TypeChecking.Primitive.Cubical where

import Prelude hiding (null, (!!))

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

import Data.Either ( partitionEithers )
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Foldable hiding (null)

import Agda.Interaction.Options ( optCubical )

import Agda.Syntax.Common
import Agda.Syntax.Internal

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

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

import Agda.Utils.Functor
import Agda.Utils.Impossible
import Agda.Utils.Maybe
import Agda.Utils.Monad
import Agda.Utils.Null
import Agda.Utils.Tuple

-- | Checks that the correct variant of Cubical Agda is activated.
-- Note that @--erased-cubical@ \"counts as\" @--cubical@ in erased
-- contexts.

requireCubical
  :: Cubical -- ^ Which variant of Cubical Agda is required?
  -> String -> TCM ()
requireCubical :: Cubical -> String -> TCM ()
requireCubical Cubical
wanted String
s = do
  Maybe Cubical
cubical         <- PragmaOptions -> Maybe Cubical
optCubical (PragmaOptions -> Maybe Cubical)
-> TCMT IO PragmaOptions -> TCMT IO (Maybe Cubical)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TCMT IO PragmaOptions
forall (m :: * -> *). HasOptions m => m PragmaOptions
pragmaOptions
  Bool
inErasedContext <- TCEnv -> Bool
forall a. LensQuantity a => a -> Bool
hasQuantity0 (TCEnv -> Bool) -> TCMT IO TCEnv -> TCMT IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TCMT IO TCEnv
getEnv
  case Maybe Cubical
cubical of
    Just Cubical
CFull -> () -> TCM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Just Cubical
CErased | Cubical
wanted Cubical -> Cubical -> Bool
forall a. Eq a => a -> a -> Bool
== Cubical
CErased Bool -> Bool -> Bool
|| Bool
inErasedContext -> () -> TCM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Maybe Cubical
_ -> TypeError -> TCM ()
forall (m :: * -> *) a.
(HasCallStack, MonadTCError m) =>
TypeError -> m a
typeError (TypeError -> TCM ()) -> TypeError -> TCM ()
forall a b. (a -> b) -> a -> b
$ String -> TypeError
GenericError (String -> TypeError) -> String -> TypeError
forall a b. (a -> b) -> a -> b
$ String
"Missing option " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
opt String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s
  where
  opt :: String
opt = case Cubical
wanted of
    Cubical
CFull   -> String
"--cubical"
    Cubical
CErased -> String
"--cubical or --erased-cubical"

primIntervalType :: (HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) => m Type
primIntervalType :: m Type
primIntervalType = Sort' Term -> Term -> Type
forall t a. Sort' t -> a -> Type'' t a
El (Level' Term -> Sort' Term
forall t. Level' t -> Sort' t
SSet (Level' Term -> Sort' Term) -> Level' Term -> Sort' Term
forall a b. (a -> b) -> a -> b
$ Integer -> Level' Term
ClosedLevel Integer
0) (Term -> Type) -> m Term -> m Type
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primInterval

primINeg' :: TCM PrimitiveImpl
primINeg' :: TCM PrimitiveImpl
primINeg' = do
  Cubical -> String -> TCM ()
requireCubical Cubical
CErased String
""
  Type
t <- TCMT IO Type
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Type
primIntervalType TCMT IO Type -> TCMT IO Type -> TCMT IO Type
forall (m :: * -> *). Applicative m => m Type -> m Type -> m Type
--> TCMT IO Type
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Type
primIntervalType
  PrimitiveImpl -> TCM PrimitiveImpl
forall (m :: * -> *) a. Monad m => a -> m a
return (PrimitiveImpl -> TCM PrimitiveImpl)
-> PrimitiveImpl -> TCM PrimitiveImpl
forall a b. (a -> b) -> a -> b
$ Type -> PrimFun -> PrimitiveImpl
PrimImpl Type
t (PrimFun -> PrimitiveImpl) -> PrimFun -> PrimitiveImpl
forall a b. (a -> b) -> a -> b
$ QName
-> Arity
-> ([Arg Term] -> ReduceM (Reduced MaybeReducedArgs Term))
-> PrimFun
primFun QName
forall a. HasCallStack => a
__IMPOSSIBLE__ Arity
1 (([Arg Term] -> ReduceM (Reduced MaybeReducedArgs Term))
 -> PrimFun)
-> ([Arg Term] -> ReduceM (Reduced MaybeReducedArgs Term))
-> PrimFun
forall a b. (a -> b) -> a -> b
$ \ [Arg Term]
ts -> do
    case [Arg Term]
ts of
     [Arg Term
x] -> do
       IntervalView -> Term
unview <- ReduceM (IntervalView -> Term)
forall (m :: * -> *). HasBuiltins m => m (IntervalView -> Term)
intervalUnview'
       Term -> IntervalView
view <- ReduceM (Term -> IntervalView)
forall (m :: * -> *). HasBuiltins m => m (Term -> IntervalView)
intervalView'
       Blocked (Arg Term)
sx <- Arg Term -> ReduceM (Blocked (Arg Term))
forall t. Reduce t => t -> ReduceM (Blocked t)
reduceB' Arg Term
x
       IntervalView
ix <- Term -> ReduceM IntervalView
forall (m :: * -> *). HasBuiltins m => Term -> m IntervalView
intervalView (Arg Term -> Term
forall e. Arg e -> e
unArg (Arg Term -> Term) -> Arg Term -> Term
forall a b. (a -> b) -> a -> b
$ Blocked (Arg Term) -> Arg Term
forall t a. Blocked' t a -> a
ignoreBlocking Blocked (Arg Term)
sx)
       let
         ineg :: Arg Term -> Arg Term
         ineg :: Arg Term -> Arg Term
ineg = (Term -> Term) -> Arg Term -> Arg Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (IntervalView -> Term
unview (IntervalView -> Term) -> (Term -> IntervalView) -> Term -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntervalView -> IntervalView
f (IntervalView -> IntervalView)
-> (Term -> IntervalView) -> Term -> IntervalView
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term -> IntervalView
view)
         f :: IntervalView -> IntervalView
f IntervalView
ix = case IntervalView
ix of
           IntervalView
IZero -> IntervalView
IOne
           IntervalView
IOne  -> IntervalView
IZero
           IMin Arg Term
x Arg Term
y -> Arg Term -> Arg Term -> IntervalView
IMax (Arg Term -> Arg Term
ineg Arg Term
x) (Arg Term -> Arg Term
ineg Arg Term
y)
           IMax Arg Term
x Arg Term
y -> Arg Term -> Arg Term -> IntervalView
IMin (Arg Term -> Arg Term
ineg Arg Term
x) (Arg Term -> Arg Term
ineg Arg Term
y)
           INeg Arg Term
x -> Term -> IntervalView
OTerm (Arg Term -> Term
forall e. Arg e -> e
unArg Arg Term
x)
           OTerm Term
t -> Arg Term -> IntervalView
INeg (ArgInfo -> Term -> Arg Term
forall e. ArgInfo -> e -> Arg e
Arg ArgInfo
defaultArgInfo Term
t)
       case IntervalView
ix of
        OTerm Term
t -> Reduced MaybeReducedArgs Term
-> ReduceM (Reduced MaybeReducedArgs Term)
forall (m :: * -> *) a. Monad m => a -> m a
return (Reduced MaybeReducedArgs Term
 -> ReduceM (Reduced MaybeReducedArgs Term))
-> Reduced MaybeReducedArgs Term
-> ReduceM (Reduced MaybeReducedArgs Term)
forall a b. (a -> b) -> a -> b
$ MaybeReducedArgs -> Reduced MaybeReducedArgs Term
forall no yes. no -> Reduced no yes
NoReduction [Blocked (Arg Term) -> MaybeReduced (Arg Term)
reduced Blocked (Arg Term)
sx]
        IntervalView
_       -> Term -> ReduceM (Reduced MaybeReducedArgs Term)
forall a a'. a -> ReduceM (Reduced a' a)
redReturn (IntervalView -> Term
unview (IntervalView -> Term) -> IntervalView -> Term
forall a b. (a -> b) -> a -> b
$ IntervalView -> IntervalView
f IntervalView
ix)
     [Arg Term]
_ -> ReduceM (Reduced MaybeReducedArgs Term)
forall a. HasCallStack => a
__IMPOSSIBLE__

primDepIMin' :: TCM PrimitiveImpl
primDepIMin' :: TCM PrimitiveImpl
primDepIMin' = do
  Cubical -> String -> TCM ()
requireCubical Cubical
CErased String
""
  Type
t <- Names -> NamesT (TCMT IO) Type -> TCMT IO Type
forall (m :: * -> *) a. Names -> NamesT m a -> m a
runNamesT [] (NamesT (TCMT IO) Type -> TCMT IO Type)
-> NamesT (TCMT IO) Type -> TCMT IO Type
forall a b. (a -> b) -> a -> b
$
       String
-> NamesT (TCMT IO) Type
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall (m :: * -> *).
(MonadFail m, MonadAddContext m, MonadDebug m) =>
String
-> NamesT m Type
-> (NamesT m Term -> NamesT m Type)
-> NamesT m Type
nPi' String
"φ" NamesT (TCMT IO) Type
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Type
primIntervalType ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
 -> NamesT (TCMT IO) Type)
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall a b. (a -> b) -> a -> b
$ \ NamesT (TCMT IO) Term
φ ->
       String
-> NamesT (TCMT IO) Term
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall (m :: * -> *).
(MonadAddContext m, HasBuiltins m, MonadDebug m) =>
String
-> NamesT m Term
-> (NamesT m Term -> NamesT m Type)
-> NamesT m Type
pPi' String
"o" NamesT (TCMT IO) Term
φ (\ NamesT (TCMT IO) Term
o -> NamesT (TCMT IO) Type
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Type
primIntervalType) NamesT (TCMT IO) Type
-> NamesT (TCMT IO) Type -> NamesT (TCMT IO) Type
forall (m :: * -> *). Applicative m => m Type -> m Type -> m Type
--> NamesT (TCMT IO) Type
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Type
primIntervalType
  PrimitiveImpl -> TCM PrimitiveImpl
forall (m :: * -> *) a. Monad m => a -> m a
return (PrimitiveImpl -> TCM PrimitiveImpl)
-> PrimitiveImpl -> TCM PrimitiveImpl
forall a b. (a -> b) -> a -> b
$ Type -> PrimFun -> PrimitiveImpl
PrimImpl Type
t (PrimFun -> PrimitiveImpl) -> PrimFun -> PrimitiveImpl
forall a b. (a -> b) -> a -> b
$ QName
-> Arity
-> ([Arg Term] -> ReduceM (Reduced MaybeReducedArgs Term))
-> PrimFun
primFun QName
forall a. HasCallStack => a
__IMPOSSIBLE__ Arity
2 (([Arg Term] -> ReduceM (Reduced MaybeReducedArgs Term))
 -> PrimFun)
-> ([Arg Term] -> ReduceM (Reduced MaybeReducedArgs Term))
-> PrimFun
forall a b. (a -> b) -> a -> b
$ \ [Arg Term]
ts -> do
    case [Arg Term]
ts of
      [Arg Term
x,Arg Term
y] -> do
        Blocked (Arg Term)
sx <- Arg Term -> ReduceM (Blocked (Arg Term))
forall t. Reduce t => t -> ReduceM (Blocked t)
reduceB' Arg Term
x
        IntervalView
ix <- Term -> ReduceM IntervalView
forall (m :: * -> *). HasBuiltins m => Term -> m IntervalView
intervalView (Arg Term -> Term
forall e. Arg e -> e
unArg (Arg Term -> Term) -> Arg Term -> Term
forall a b. (a -> b) -> a -> b
$ Blocked (Arg Term) -> Arg Term
forall t a. Blocked' t a -> a
ignoreBlocking Blocked (Arg Term)
sx)
        Term
itisone <- String -> String -> ReduceM Term
forall (m :: * -> *). HasBuiltins m => String -> String -> m Term
getTerm String
"primDepIMin" String
builtinItIsOne
        case IntervalView
ix of
          IntervalView
IZero -> Term -> ReduceM (Reduced MaybeReducedArgs Term)
forall a a'. a -> ReduceM (Reduced a' a)
redReturn (Term -> ReduceM (Reduced MaybeReducedArgs Term))
-> ReduceM Term -> ReduceM (Reduced MaybeReducedArgs Term)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IntervalView -> ReduceM Term
forall (m :: * -> *). HasBuiltins m => IntervalView -> m Term
intervalUnview IntervalView
IZero
          IntervalView
IOne  -> Term -> ReduceM (Reduced MaybeReducedArgs Term)
forall a a'. a -> ReduceM (Reduced a' a)
redReturn (Term -> ReduceM (Reduced MaybeReducedArgs Term))
-> ReduceM Term -> ReduceM (Reduced MaybeReducedArgs Term)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Term -> ReduceM Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Arg Term -> Term
forall e. Arg e -> e
unArg Arg Term
y) ReduceM Term -> ReduceM Term -> ReduceM Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> Term -> ReduceM Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
itisone)
          IntervalView
_     -> do
            Blocked (Arg Term)
sy <- Arg Term -> ReduceM (Blocked (Arg Term))
forall t. Reduce t => t -> ReduceM (Blocked t)
reduceB' Arg Term
y
            IntervalView
iy <- Term -> ReduceM IntervalView
forall (m :: * -> *). HasBuiltins m => Term -> m IntervalView
intervalView (Term -> ReduceM IntervalView)
-> ReduceM Term -> ReduceM IntervalView
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Term -> ReduceM Term
forall t. Reduce t => t -> ReduceM t
reduce' (Term -> ReduceM Term) -> ReduceM Term -> ReduceM Term
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Term -> ReduceM Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Arg Term -> Term
forall e. Arg e -> e
unArg (Arg Term -> Term) -> Arg Term -> Term
forall a b. (a -> b) -> a -> b
$ Blocked (Arg Term) -> Arg Term
forall t a. Blocked' t a -> a
ignoreBlocking Blocked (Arg Term)
sy) ReduceM Term -> ReduceM Term -> ReduceM Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> Term -> ReduceM Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
itisone)
            case IntervalView
iy of
              IntervalView
IZero -> Term -> ReduceM (Reduced MaybeReducedArgs Term)
forall a a'. a -> ReduceM (Reduced a' a)
redReturn (Term -> ReduceM (Reduced MaybeReducedArgs Term))
-> ReduceM Term -> ReduceM (Reduced MaybeReducedArgs Term)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IntervalView -> ReduceM Term
forall (m :: * -> *). HasBuiltins m => IntervalView -> m Term
intervalUnview IntervalView
IZero
              IntervalView
IOne  -> Term -> ReduceM (Reduced MaybeReducedArgs Term)
forall a a'. a -> ReduceM (Reduced a' a)
redReturn (Arg Term -> Term
forall e. Arg e -> e
unArg (Arg Term -> Term) -> Arg Term -> Term
forall a b. (a -> b) -> a -> b
$ Blocked (Arg Term) -> Arg Term
forall t a. Blocked' t a -> a
ignoreBlocking Blocked (Arg Term)
sx)
              IntervalView
_     -> Reduced MaybeReducedArgs Term
-> ReduceM (Reduced MaybeReducedArgs Term)
forall (m :: * -> *) a. Monad m => a -> m a
return (Reduced MaybeReducedArgs Term
 -> ReduceM (Reduced MaybeReducedArgs Term))
-> Reduced MaybeReducedArgs Term
-> ReduceM (Reduced MaybeReducedArgs Term)
forall a b. (a -> b) -> a -> b
$ MaybeReducedArgs -> Reduced MaybeReducedArgs Term
forall no yes. no -> Reduced no yes
NoReduction [Blocked (Arg Term) -> MaybeReduced (Arg Term)
reduced Blocked (Arg Term)
sx, Blocked (Arg Term) -> MaybeReduced (Arg Term)
reduced Blocked (Arg Term)
sy]
      [Arg Term]
_      -> ReduceM (Reduced MaybeReducedArgs Term)
forall a. HasCallStack => a
__IMPOSSIBLE__

primIBin :: IntervalView -> IntervalView -> TCM PrimitiveImpl
primIBin :: IntervalView -> IntervalView -> TCM PrimitiveImpl
primIBin IntervalView
unit IntervalView
absorber = do
  Cubical -> String -> TCM ()
requireCubical Cubical
CErased String
""
  Type
t <- TCMT IO Type
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Type
primIntervalType TCMT IO Type -> TCMT IO Type -> TCMT IO Type
forall (m :: * -> *). Applicative m => m Type -> m Type -> m Type
--> TCMT IO Type
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Type
primIntervalType TCMT IO Type -> TCMT IO Type -> TCMT IO Type
forall (m :: * -> *). Applicative m => m Type -> m Type -> m Type
--> TCMT IO Type
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Type
primIntervalType
  PrimitiveImpl -> TCM PrimitiveImpl
forall (m :: * -> *) a. Monad m => a -> m a
return (PrimitiveImpl -> TCM PrimitiveImpl)
-> PrimitiveImpl -> TCM PrimitiveImpl
forall a b. (a -> b) -> a -> b
$ Type -> PrimFun -> PrimitiveImpl
PrimImpl Type
t (PrimFun -> PrimitiveImpl) -> PrimFun -> PrimitiveImpl
forall a b. (a -> b) -> a -> b
$ QName
-> Arity
-> ([Arg Term] -> ReduceM (Reduced MaybeReducedArgs Term))
-> PrimFun
primFun QName
forall a. HasCallStack => a
__IMPOSSIBLE__ Arity
2 (([Arg Term] -> ReduceM (Reduced MaybeReducedArgs Term))
 -> PrimFun)
-> ([Arg Term] -> ReduceM (Reduced MaybeReducedArgs Term))
-> PrimFun
forall a b. (a -> b) -> a -> b
$ \ [Arg Term]
ts -> do
    case [Arg Term]
ts of
     [Arg Term
x,Arg Term
y] -> do
       Blocked (Arg Term)
sx <- Arg Term -> ReduceM (Blocked (Arg Term))
forall t. Reduce t => t -> ReduceM (Blocked t)
reduceB' Arg Term
x
       IntervalView
ix <- Term -> ReduceM IntervalView
forall (m :: * -> *). HasBuiltins m => Term -> m IntervalView
intervalView (Arg Term -> Term
forall e. Arg e -> e
unArg (Arg Term -> Term) -> Arg Term -> Term
forall a b. (a -> b) -> a -> b
$ Blocked (Arg Term) -> Arg Term
forall t a. Blocked' t a -> a
ignoreBlocking Blocked (Arg Term)
sx)
       case IntervalView
ix of
         IntervalView
ix | IntervalView
ix IntervalView -> IntervalView -> Bool
==% IntervalView
absorber -> Term -> ReduceM (Reduced MaybeReducedArgs Term)
forall a a'. a -> ReduceM (Reduced a' a)
redReturn (Term -> ReduceM (Reduced MaybeReducedArgs Term))
-> ReduceM Term -> ReduceM (Reduced MaybeReducedArgs Term)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IntervalView -> ReduceM Term
forall (m :: * -> *). HasBuiltins m => IntervalView -> m Term
intervalUnview IntervalView
absorber
         IntervalView
ix | IntervalView
ix IntervalView -> IntervalView -> Bool
==% IntervalView
unit     -> Reduced MaybeReducedArgs Term
-> ReduceM (Reduced MaybeReducedArgs Term)
forall (m :: * -> *) a. Monad m => a -> m a
return (Reduced MaybeReducedArgs Term
 -> ReduceM (Reduced MaybeReducedArgs Term))
-> Reduced MaybeReducedArgs Term
-> ReduceM (Reduced MaybeReducedArgs Term)
forall a b. (a -> b) -> a -> b
$ Simplification -> Term -> Reduced MaybeReducedArgs Term
forall no yes. Simplification -> yes -> Reduced no yes
YesReduction Simplification
YesSimplification (Arg Term -> Term
forall e. Arg e -> e
unArg Arg Term
y)
         IntervalView
_     -> do
           Blocked (Arg Term)
sy <- Arg Term -> ReduceM (Blocked (Arg Term))
forall t. Reduce t => t -> ReduceM (Blocked t)
reduceB' Arg Term
y
           IntervalView
iy <- Term -> ReduceM IntervalView
forall (m :: * -> *). HasBuiltins m => Term -> m IntervalView
intervalView (Arg Term -> Term
forall e. Arg e -> e
unArg (Arg Term -> Term) -> Arg Term -> Term
forall a b. (a -> b) -> a -> b
$ Blocked (Arg Term) -> Arg Term
forall t a. Blocked' t a -> a
ignoreBlocking Blocked (Arg Term)
sy)
           case IntervalView
iy of
            IntervalView
iy | IntervalView
iy IntervalView -> IntervalView -> Bool
==% IntervalView
absorber -> Term -> ReduceM (Reduced MaybeReducedArgs Term)
forall a a'. a -> ReduceM (Reduced a' a)
redReturn (Term -> ReduceM (Reduced MaybeReducedArgs Term))
-> ReduceM Term -> ReduceM (Reduced MaybeReducedArgs Term)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IntervalView -> ReduceM Term
forall (m :: * -> *). HasBuiltins m => IntervalView -> m Term
intervalUnview IntervalView
absorber
            IntervalView
iy | IntervalView
iy IntervalView -> IntervalView -> Bool
==% IntervalView
unit     -> Reduced MaybeReducedArgs Term
-> ReduceM (Reduced MaybeReducedArgs Term)
forall (m :: * -> *) a. Monad m => a -> m a
return (Reduced MaybeReducedArgs Term
 -> ReduceM (Reduced MaybeReducedArgs Term))
-> Reduced MaybeReducedArgs Term
-> ReduceM (Reduced MaybeReducedArgs Term)
forall a b. (a -> b) -> a -> b
$ Simplification -> Term -> Reduced MaybeReducedArgs Term
forall no yes. Simplification -> yes -> Reduced no yes
YesReduction Simplification
YesSimplification (Arg Term -> Term
forall e. Arg e -> e
unArg Arg Term
x)
            IntervalView
_                   -> Reduced MaybeReducedArgs Term
-> ReduceM (Reduced MaybeReducedArgs Term)
forall (m :: * -> *) a. Monad m => a -> m a
return (Reduced MaybeReducedArgs Term
 -> ReduceM (Reduced MaybeReducedArgs Term))
-> Reduced MaybeReducedArgs Term
-> ReduceM (Reduced MaybeReducedArgs Term)
forall a b. (a -> b) -> a -> b
$ MaybeReducedArgs -> Reduced MaybeReducedArgs Term
forall no yes. no -> Reduced no yes
NoReduction [Blocked (Arg Term) -> MaybeReduced (Arg Term)
reduced Blocked (Arg Term)
sx,Blocked (Arg Term) -> MaybeReduced (Arg Term)
reduced Blocked (Arg Term)
sy]
     [Arg Term]
_ -> ReduceM (Reduced MaybeReducedArgs Term)
forall a. HasCallStack => a
__IMPOSSIBLE__
  where
    ==% :: IntervalView -> IntervalView -> Bool
(==%) IntervalView
IZero IntervalView
IZero = Bool
True
    (==%) IntervalView
IOne IntervalView
IOne = Bool
True
    (==%) IntervalView
_ IntervalView
_ = Bool
False


primIMin' :: TCM PrimitiveImpl
primIMin' :: TCM PrimitiveImpl
primIMin' = do
  Cubical -> String -> TCM ()
requireCubical Cubical
CErased String
""
  IntervalView -> IntervalView -> TCM PrimitiveImpl
primIBin IntervalView
IOne IntervalView
IZero

primIMax' :: TCM PrimitiveImpl
primIMax' :: TCM PrimitiveImpl
primIMax' = do
  Cubical -> String -> TCM ()
requireCubical Cubical
CErased String
""
  IntervalView -> IntervalView -> TCM PrimitiveImpl
primIBin IntervalView
IZero IntervalView
IOne

imax :: HasBuiltins m => m Term -> m Term -> m Term
imax :: m Term -> m Term -> m Term
imax m Term
x m Term
y = do
  Term
x' <- m Term
x
  Term
y' <- m Term
y
  IntervalView -> m Term
forall (m :: * -> *). HasBuiltins m => IntervalView -> m Term
intervalUnview (Arg Term -> Arg Term -> IntervalView
IMax (Term -> Arg Term
forall e. e -> Arg e
argN Term
x') (Term -> Arg Term
forall e. e -> Arg e
argN Term
y'))

imin :: HasBuiltins m => m Term -> m Term -> m Term
imin :: m Term -> m Term -> m Term
imin m Term
x m Term
y = do
  Term
x' <- m Term
x
  Term
y' <- m Term
y
  IntervalView -> m Term
forall (m :: * -> *). HasBuiltins m => IntervalView -> m Term
intervalUnview (Arg Term -> Arg Term -> IntervalView
IMin (Term -> Arg Term
forall e. e -> Arg e
argN Term
x') (Term -> Arg Term
forall e. e -> Arg e
argN Term
y'))

-- ∀ {a}{c}{A : Set a}{x : A}(C : ∀ y → Id x y → Set c) → C x (conid i1 (\ i → x)) → ∀ {y} (p : Id x y) → C y p
primIdJ :: TCM PrimitiveImpl
primIdJ :: TCM PrimitiveImpl
primIdJ = do
  Cubical -> String -> TCM ()
requireCubical Cubical
CErased String
""
  Type
t <- Names -> NamesT (TCMT IO) Type -> TCMT IO Type
forall (m :: * -> *) a. Names -> NamesT m a -> m a
runNamesT [] (NamesT (TCMT IO) Type -> TCMT IO Type)
-> NamesT (TCMT IO) Type -> TCMT IO Type
forall a b. (a -> b) -> a -> b
$
       String
-> NamesT (TCMT IO) Type
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall (m :: * -> *).
(MonadFail m, MonadAddContext m, MonadDebug m) =>
String
-> NamesT m Type
-> (NamesT m Term -> NamesT m Type)
-> NamesT m Type
hPi' String
"a" (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
forall (m :: * -> *). Functor m => m Term -> m Type
el (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
forall a b. (a -> b) -> a -> b
$ TCMT IO Term -> NamesT (TCMT IO) Term
forall (m :: * -> *) a. Monad m => m a -> NamesT m a
cl TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primLevel) ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
 -> NamesT (TCMT IO) Type)
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall a b. (a -> b) -> a -> b
$ \ NamesT (TCMT IO) Term
a ->
       String
-> NamesT (TCMT IO) Type
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall (m :: * -> *).
(MonadFail m, MonadAddContext m, MonadDebug m) =>
String
-> NamesT m Type
-> (NamesT m Term -> NamesT m Type)
-> NamesT m Type
hPi' String
"c" (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
forall (m :: * -> *). Functor m => m Term -> m Type
el (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
forall a b. (a -> b) -> a -> b
$ TCMT IO Term -> NamesT (TCMT IO) Term
forall (m :: * -> *) a. Monad m => m a -> NamesT m a
cl TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primLevel) ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
 -> NamesT (TCMT IO) Type)
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall a b. (a -> b) -> a -> b
$ \ NamesT (TCMT IO) Term
c ->
       String
-> NamesT (TCMT IO) Type
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall (m :: * -> *).
(MonadFail m, MonadAddContext m, MonadDebug m) =>
String
-> NamesT m Type
-> (NamesT m Term -> NamesT m Type)
-> NamesT m Type
hPi' String
"A" (Sort' Term -> Type
sort (Sort' Term -> Type) -> (Term -> Sort' Term) -> Term -> Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term -> Sort' Term
tmSort (Term -> Type) -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamesT (TCMT IO) Term
a) ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
 -> NamesT (TCMT IO) Type)
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall a b. (a -> b) -> a -> b
$ \ NamesT (TCMT IO) Term
bA ->
       String
-> NamesT (TCMT IO) Type
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall (m :: * -> *).
(MonadFail m, MonadAddContext m, MonadDebug m) =>
String
-> NamesT m Type
-> (NamesT m Term -> NamesT m Type)
-> NamesT m Type
hPi' String
"x" (NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Type
el' NamesT (TCMT IO) Term
a NamesT (TCMT IO) Term
bA) ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
 -> NamesT (TCMT IO) Type)
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall a b. (a -> b) -> a -> b
$ \ NamesT (TCMT IO) Term
x ->
       String
-> NamesT (TCMT IO) Type
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall (m :: * -> *).
(MonadFail m, MonadAddContext m, MonadDebug m) =>
String
-> NamesT m Type
-> (NamesT m Term -> NamesT m Type)
-> NamesT m Type
nPi' String
"C" (String
-> NamesT (TCMT IO) Type
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall (m :: * -> *).
(MonadFail m, MonadAddContext m, MonadDebug m) =>
String
-> NamesT m Type
-> (NamesT m Term -> NamesT m Type)
-> NamesT m Type
nPi' String
"y" (NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Type
el' NamesT (TCMT IO) Term
a NamesT (TCMT IO) Term
bA) ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
 -> NamesT (TCMT IO) Type)
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall a b. (a -> b) -> a -> b
$ \ NamesT (TCMT IO) Term
y ->
                 NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Type
el' NamesT (TCMT IO) Term
a (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
primId NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> NamesT (TCMT IO) Term
a NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> NamesT (TCMT IO) Term
bA NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT (TCMT IO) Term
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) Type
-> NamesT (TCMT IO) Type -> NamesT (TCMT IO) Type
forall (m :: * -> *). Applicative m => m Type -> m Type -> m Type
--> (Sort' Term -> Type
sort (Sort' Term -> Type) -> (Term -> Sort' Term) -> Term -> Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term -> Sort' Term
tmSort (Term -> Type) -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamesT (TCMT IO) Term
c)) ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
 -> NamesT (TCMT IO) Type)
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall a b. (a -> b) -> a -> b
$ \ NamesT (TCMT IO) Term
bC ->
       NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Type
el' NamesT (TCMT IO) Term
c (NamesT (TCMT IO) Term
bC 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
<@>
            (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
a NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> NamesT (TCMT IO) Term
bA NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> NamesT (TCMT IO) Term
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
x NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> TCMT IO Term -> NamesT (TCMT IO) Term
forall (m :: * -> *) a. Monad m => m a -> NamesT m a
cl TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primIOne
                       NamesT (TCMT IO) Term
-> 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
x))) 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) Type
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall (m :: * -> *).
(MonadFail m, MonadAddContext m, MonadDebug m) =>
String
-> NamesT m Type
-> (NamesT m Term -> NamesT m Type)
-> NamesT m Type
hPi' String
"y" (NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Type
el' NamesT (TCMT IO) Term
a NamesT (TCMT IO) Term
bA) (\ NamesT (TCMT IO) Term
y ->
        String
-> NamesT (TCMT IO) Type
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall (m :: * -> *).
(MonadFail m, MonadAddContext m, MonadDebug m) =>
String
-> NamesT m Type
-> (NamesT m Term -> NamesT m Type)
-> NamesT m Type
nPi' String
"p" (NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Type
el' NamesT (TCMT IO) Term
a (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
forall a b. (a -> b) -> a -> b
$ TCMT IO Term -> NamesT (TCMT IO) Term
forall (m :: * -> *) a. Monad m => m a -> NamesT m a
cl TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primId NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> NamesT (TCMT IO) Term
a NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> NamesT (TCMT IO) Term
bA NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT (TCMT IO) Term
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) Type)
 -> NamesT (TCMT IO) Type)
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall a b. (a -> b) -> a -> b
$ \ NamesT (TCMT IO) Term
p ->
        NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Type
el' NamesT (TCMT IO) Term
c (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
forall a b. (a -> b) -> a -> b
$ NamesT (TCMT IO) Term
bC 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
p)
  Maybe QName
conidn <- String -> TCMT IO (Maybe QName)
forall (m :: * -> *).
(HasBuiltins m, MonadReduce m) =>
String -> m (Maybe QName)
getBuiltinName String
builtinConId
  Term
conid  <- TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primConId
  -- TODO make a kit
  PrimitiveImpl -> TCM PrimitiveImpl
forall (m :: * -> *) a. Monad m => a -> m a
return (PrimitiveImpl -> TCM PrimitiveImpl)
-> PrimitiveImpl -> TCM PrimitiveImpl
forall a b. (a -> b) -> a -> b
$ Type -> PrimFun -> PrimitiveImpl
PrimImpl Type
t (PrimFun -> PrimitiveImpl) -> PrimFun -> PrimitiveImpl
forall a b. (a -> b) -> a -> b
$ QName
-> Arity
-> ([Arg Term] -> ReduceM (Reduced MaybeReducedArgs Term))
-> PrimFun
primFun QName
forall a. HasCallStack => a
__IMPOSSIBLE__ Arity
8 (([Arg Term] -> ReduceM (Reduced MaybeReducedArgs Term))
 -> PrimFun)
-> ([Arg Term] -> ReduceM (Reduced MaybeReducedArgs Term))
-> PrimFun
forall a b. (a -> b) -> a -> b
$ \ [Arg Term]
ts -> do
    IntervalView -> Term
unview <- ReduceM (IntervalView -> Term)
forall (m :: * -> *). HasBuiltins m => m (IntervalView -> Term)
intervalUnview'
    let imax :: NamesT Fail Term -> NamesT Fail Term -> NamesT Fail Term
imax NamesT Fail Term
x NamesT Fail Term
y = do Term
x' <- NamesT Fail Term
x; IntervalView -> Term
unview (IntervalView -> Term) -> (Term -> IntervalView) -> Term -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Arg Term -> Arg Term -> IntervalView
IMax (Term -> Arg Term
forall e. e -> Arg e
argN Term
x') (Arg Term -> IntervalView)
-> (Term -> Arg Term) -> Term -> IntervalView
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term -> Arg Term
forall e. e -> Arg e
argN (Term -> Term) -> NamesT Fail Term -> NamesT Fail Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamesT Fail Term
y;
        imin :: NamesT Fail Term -> NamesT Fail Term -> NamesT Fail Term
imin NamesT Fail Term
x NamesT Fail Term
y = do Term
x' <- NamesT Fail Term
x; IntervalView -> Term
unview (IntervalView -> Term) -> (Term -> IntervalView) -> Term -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Arg Term -> Arg Term -> IntervalView
IMin (Term -> Arg Term
forall e. e -> Arg e
argN Term
x') (Arg Term -> IntervalView)
-> (Term -> Arg Term) -> Term -> IntervalView
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term -> Arg Term
forall e. e -> Arg e
argN (Term -> Term) -> NamesT Fail Term -> NamesT Fail Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamesT Fail Term
y;
        ineg :: NamesT Fail Term -> NamesT Fail Term
ineg NamesT Fail Term
x = IntervalView -> Term
unview (IntervalView -> Term) -> (Term -> IntervalView) -> Term -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Arg Term -> IntervalView
INeg (Arg Term -> IntervalView)
-> (Term -> Arg Term) -> Term -> IntervalView
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term -> Arg Term
forall e. e -> Arg e
argN (Term -> Term) -> NamesT Fail Term -> NamesT Fail Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamesT Fail Term
x
    Maybe Term
mcomp <- String -> ReduceM (Maybe Term)
forall (m :: * -> *). HasBuiltins m => String -> m (Maybe Term)
getTerm' String
"primComp"
    case [Arg Term]
ts of
     [Arg Term
la,Arg Term
lc,Arg Term
a,Arg Term
x,Arg Term
c,Arg Term
d,Arg Term
y,Arg Term
eq] -> do
       Blocked (Arg Term)
seq    <- Arg Term -> ReduceM (Blocked (Arg Term))
forall t. Reduce t => t -> ReduceM (Blocked t)
reduceB' Arg Term
eq
       case Arg Term -> Term
forall e. Arg e -> e
unArg (Arg Term -> Term) -> Arg Term -> Term
forall a b. (a -> b) -> a -> b
$ Blocked (Arg Term) -> Arg Term
forall t a. Blocked' t a -> a
ignoreBlocking (Blocked (Arg Term) -> Arg Term) -> Blocked (Arg Term) -> Arg Term
forall a b. (a -> b) -> a -> b
$ Blocked (Arg Term)
seq of
         (Def QName
q [Apply Arg Term
la,Apply Arg Term
a,Apply Arg Term
x,Apply Arg Term
y,Apply Arg Term
phi,Apply Arg Term
p])
           | QName -> Maybe QName
forall a. a -> Maybe a
Just QName
q Maybe QName -> Maybe QName -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe QName
conidn, Just Term
comp <- Maybe Term
mcomp -> do
          Term -> ReduceM (Reduced MaybeReducedArgs Term)
forall a a'. a -> ReduceM (Reduced a' a)
redReturn (Term -> ReduceM (Reduced MaybeReducedArgs Term))
-> Term -> ReduceM (Reduced MaybeReducedArgs Term)
forall a b. (a -> b) -> a -> b
$ Names -> NamesT Fail Term -> Term
forall a. Names -> NamesT Fail a -> a
runNames [] (NamesT Fail Term -> Term) -> NamesT Fail Term -> Term
forall a b. (a -> b) -> a -> b
$ do
             [NamesT Fail Term
lc,NamesT Fail Term
c,NamesT Fail Term
d,NamesT Fail Term
la,NamesT Fail Term
a,NamesT Fail Term
x,NamesT Fail Term
y,NamesT Fail Term
phi,NamesT Fail Term
p] <- (Arg Term -> NamesT Fail (NamesT Fail Term))
-> [Arg Term] -> NamesT Fail [NamesT Fail Term]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Term -> NamesT Fail (NamesT Fail Term)
forall (m :: * -> *) a.
(MonadFail m, Subst a) =>
a -> NamesT m (NamesT m a)
open (Term -> NamesT Fail (NamesT Fail Term))
-> (Arg Term -> Term) -> Arg Term -> NamesT Fail (NamesT Fail Term)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Arg Term -> Term
forall e. Arg e -> e
unArg) [Arg Term
lc,Arg Term
c,Arg Term
d,Arg Term
la,Arg Term
a,Arg Term
x,Arg Term
y,Arg Term
phi,Arg Term
p]
             let w :: NamesT Fail Term -> NamesT Fail Term
w NamesT Fail Term
i = do
                   [Term
x,Term
y,Term
p,Term
i] <- [NamesT Fail Term] -> NamesT Fail [Term]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [NamesT Fail Term
x,NamesT Fail Term
y,NamesT Fail Term
p,NamesT Fail Term
i]
                   Term -> NamesT Fail Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term -> NamesT Fail Term) -> Term -> NamesT Fail Term
forall a b. (a -> b) -> a -> b
$ Term
p Term -> [Elim] -> Term
forall t. Apply t => t -> [Elim] -> t
`applyE` [Term -> Term -> Term -> Elim
forall a. a -> a -> a -> Elim' a
IApply Term
x Term
y Term
i]
             Term -> NamesT Fail Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
comp NamesT Fail Term -> NamesT Fail Term -> NamesT Fail Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> String
-> (NamesT Fail Term -> NamesT Fail Term) -> NamesT Fail Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
lam String
"i" (\ NamesT Fail Term
_ -> NamesT Fail Term
lc)
                       NamesT Fail Term -> NamesT Fail Term -> NamesT Fail Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> String
-> (NamesT Fail Term -> NamesT Fail Term) -> NamesT Fail Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
lam String
"i" (\ NamesT Fail Term
i ->
                              NamesT Fail Term
c NamesT Fail Term -> NamesT Fail Term -> NamesT Fail Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> (NamesT Fail Term -> NamesT Fail Term
w NamesT Fail Term
i)
                                NamesT Fail Term -> NamesT Fail Term -> NamesT Fail Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> (Term -> NamesT Fail Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
conid NamesT Fail Term -> NamesT Fail Term -> NamesT Fail Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> NamesT Fail Term
la NamesT Fail Term -> NamesT Fail Term -> NamesT Fail Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> NamesT Fail Term
a NamesT Fail Term -> NamesT Fail Term -> NamesT Fail Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> NamesT Fail Term
x NamesT Fail Term -> NamesT Fail Term -> NamesT Fail Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> (NamesT Fail Term -> NamesT Fail Term
w NamesT Fail Term
i)
                                                NamesT Fail Term -> NamesT Fail Term -> NamesT Fail Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> (NamesT Fail Term
phi NamesT Fail Term -> NamesT Fail Term -> NamesT Fail Term
`imax` NamesT Fail Term -> NamesT Fail Term
ineg NamesT Fail Term
i)
                                                NamesT Fail Term -> NamesT Fail Term -> NamesT Fail Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> String
-> (NamesT Fail Term -> NamesT Fail Term) -> NamesT Fail Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
lam String
"j" (\ NamesT Fail Term
j -> NamesT Fail Term -> NamesT Fail Term
w (NamesT Fail Term -> NamesT Fail Term)
-> NamesT Fail Term -> NamesT Fail Term
forall a b. (a -> b) -> a -> b
$ NamesT Fail Term -> NamesT Fail Term -> NamesT Fail Term
imin NamesT Fail Term
i NamesT Fail Term
j)))
                       NamesT Fail Term -> NamesT Fail Term -> NamesT Fail Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> NamesT Fail Term
phi
                       NamesT Fail Term -> NamesT Fail Term -> NamesT Fail Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> String
-> (NamesT Fail Term -> NamesT Fail Term) -> NamesT Fail Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
lam String
"i" (\ NamesT Fail Term
_ -> Term -> Term
nolam (Term -> Term) -> NamesT Fail Term -> NamesT Fail Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamesT Fail Term
d) -- TODO block
                       NamesT Fail Term -> NamesT Fail Term -> NamesT Fail Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT Fail Term
d
         Term
_ -> Reduced MaybeReducedArgs Term
-> ReduceM (Reduced MaybeReducedArgs Term)
forall (m :: * -> *) a. Monad m => a -> m a
return (Reduced MaybeReducedArgs Term
 -> ReduceM (Reduced MaybeReducedArgs Term))
-> Reduced MaybeReducedArgs Term
-> ReduceM (Reduced MaybeReducedArgs Term)
forall a b. (a -> b) -> a -> b
$ MaybeReducedArgs -> Reduced MaybeReducedArgs Term
forall no yes. no -> Reduced no yes
NoReduction (MaybeReducedArgs -> Reduced MaybeReducedArgs Term)
-> MaybeReducedArgs -> Reduced MaybeReducedArgs Term
forall a b. (a -> b) -> a -> b
$ (Arg Term -> MaybeReduced (Arg Term))
-> [Arg Term] -> MaybeReducedArgs
forall a b. (a -> b) -> [a] -> [b]
map Arg Term -> MaybeReduced (Arg Term)
forall a. a -> MaybeReduced a
notReduced [Arg Term
la,Arg Term
lc,Arg Term
a,Arg Term
x,Arg Term
c,Arg Term
d,Arg Term
y] MaybeReducedArgs -> MaybeReducedArgs -> MaybeReducedArgs
forall a. [a] -> [a] -> [a]
++ [Blocked (Arg Term) -> MaybeReduced (Arg Term)
reduced Blocked (Arg Term)
seq]
     [Arg Term]
_ -> ReduceM (Reduced MaybeReducedArgs Term)
forall a. HasCallStack => a
__IMPOSSIBLE__

primIdElim' :: TCM PrimitiveImpl
primIdElim' :: TCM PrimitiveImpl
primIdElim' = do
  Cubical -> String -> TCM ()
requireCubical Cubical
CErased String
""
  Type
t <- Names -> NamesT (TCMT IO) Type -> TCMT IO Type
forall (m :: * -> *) a. Names -> NamesT m a -> m a
runNamesT [] (NamesT (TCMT IO) Type -> TCMT IO Type)
-> NamesT (TCMT IO) Type -> TCMT IO Type
forall a b. (a -> b) -> a -> b
$
       String
-> NamesT (TCMT IO) Type
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall (m :: * -> *).
(MonadFail m, MonadAddContext m, MonadDebug m) =>
String
-> NamesT m Type
-> (NamesT m Term -> NamesT m Type)
-> NamesT m Type
hPi' String
"a" (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
forall (m :: * -> *). Functor m => m Term -> m Type
el (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
forall a b. (a -> b) -> a -> b
$ TCMT IO Term -> NamesT (TCMT IO) Term
forall (m :: * -> *) a. Monad m => m a -> NamesT m a
cl TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primLevel) ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
 -> NamesT (TCMT IO) Type)
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall a b. (a -> b) -> a -> b
$ \ NamesT (TCMT IO) Term
a ->
       String
-> NamesT (TCMT IO) Type
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall (m :: * -> *).
(MonadFail m, MonadAddContext m, MonadDebug m) =>
String
-> NamesT m Type
-> (NamesT m Term -> NamesT m Type)
-> NamesT m Type
hPi' String
"c" (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
forall (m :: * -> *). Functor m => m Term -> m Type
el (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
forall a b. (a -> b) -> a -> b
$ TCMT IO Term -> NamesT (TCMT IO) Term
forall (m :: * -> *) a. Monad m => m a -> NamesT m a
cl TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primLevel) ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
 -> NamesT (TCMT IO) Type)
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall a b. (a -> b) -> a -> b
$ \ NamesT (TCMT IO) Term
c ->
       String
-> NamesT (TCMT IO) Type
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall (m :: * -> *).
(MonadFail m, MonadAddContext m, MonadDebug m) =>
String
-> NamesT m Type
-> (NamesT m Term -> NamesT m Type)
-> NamesT m Type
hPi' String
"A" (Sort' Term -> Type
sort (Sort' Term -> Type) -> (Term -> Sort' Term) -> Term -> Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term -> Sort' Term
tmSort (Term -> Type) -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamesT (TCMT IO) Term
a) ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
 -> NamesT (TCMT IO) Type)
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall a b. (a -> b) -> a -> b
$ \ NamesT (TCMT IO) Term
bA ->
       String
-> NamesT (TCMT IO) Type
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall (m :: * -> *).
(MonadFail m, MonadAddContext m, MonadDebug m) =>
String
-> NamesT m Type
-> (NamesT m Term -> NamesT m Type)
-> NamesT m Type
hPi' String
"x" (NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Type
el' NamesT (TCMT IO) Term
a NamesT (TCMT IO) Term
bA) ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
 -> NamesT (TCMT IO) Type)
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall a b. (a -> b) -> a -> b
$ \ NamesT (TCMT IO) Term
x ->
       String
-> NamesT (TCMT IO) Type
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall (m :: * -> *).
(MonadFail m, MonadAddContext m, MonadDebug m) =>
String
-> NamesT m Type
-> (NamesT m Term -> NamesT m Type)
-> NamesT m Type
nPi' String
"C" (String
-> NamesT (TCMT IO) Type
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall (m :: * -> *).
(MonadFail m, MonadAddContext m, MonadDebug m) =>
String
-> NamesT m Type
-> (NamesT m Term -> NamesT m Type)
-> NamesT m Type
nPi' String
"y" (NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Type
el' NamesT (TCMT IO) Term
a NamesT (TCMT IO) Term
bA) ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
 -> NamesT (TCMT IO) Type)
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall a b. (a -> b) -> a -> b
$ \ NamesT (TCMT IO) Term
y ->
                 NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Type
el' NamesT (TCMT IO) Term
a (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
primId NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> NamesT (TCMT IO) Term
a NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> NamesT (TCMT IO) Term
bA NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT (TCMT IO) Term
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) Type
-> NamesT (TCMT IO) Type -> NamesT (TCMT IO) Type
forall (m :: * -> *). Applicative m => m Type -> m Type -> m Type
--> (Sort' Term -> Type
sort (Sort' Term -> Type) -> (Term -> Sort' Term) -> Term -> Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term -> Sort' Term
tmSort (Term -> Type) -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamesT (TCMT IO) Term
c)) ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
 -> NamesT (TCMT IO) Type)
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall a b. (a -> b) -> a -> b
$ \ NamesT (TCMT IO) Term
bC ->
       String
-> NamesT (TCMT IO) Type
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall (m :: * -> *).
(MonadFail m, MonadAddContext m, MonadDebug m) =>
String
-> NamesT m Type
-> (NamesT m Term -> NamesT m Type)
-> NamesT m Type
nPi' String
"φ" NamesT (TCMT IO) Type
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Type
primIntervalType (\ NamesT (TCMT IO) Term
phi ->
        String
-> NamesT (TCMT IO) Type
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall (m :: * -> *).
(MonadFail m, MonadAddContext m, MonadDebug m) =>
String
-> NamesT m Type
-> (NamesT m Term -> NamesT m Type)
-> NamesT m Type
nPi' String
"y" (NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Type
el's NamesT (TCMT IO) Term
a (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
forall a b. (a -> b) -> a -> b
$ TCMT IO Term -> NamesT (TCMT IO) Term
forall (m :: * -> *) a. Monad m => m a -> NamesT m a
cl TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primSub NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> NamesT (TCMT IO) Term
a NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT (TCMT IO) Term
bA NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT (TCMT IO) Term
phi NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> 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
"o" (NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall a b. a -> b -> a
const NamesT (TCMT IO) Term
x)) ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
 -> NamesT (TCMT IO) Type)
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall a b. (a -> b) -> a -> b
$ \ NamesT (TCMT IO) Term
y ->
        let pathxy :: NamesT (TCMT IO) Term
pathxy = (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
primPath NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> NamesT (TCMT IO) Term
a NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT (TCMT IO) Term
bA NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT (TCMT IO) Term
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
oucy)
            oucy :: NamesT (TCMT IO) Term
oucy = (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
primSubOut NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> NamesT (TCMT IO) Term
a NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> NamesT (TCMT IO) Term
bA NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> NamesT (TCMT IO) Term
phi NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> 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
"o" (NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall a b. a -> b -> a
const 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)
            reflx :: NamesT (TCMT IO) Term
reflx = (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
"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
_ -> 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
_ -> NamesT (TCMT IO) Term
x) -- TODO Andrea, should block on o
        in
        String
-> NamesT (TCMT IO) Type
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall (m :: * -> *).
(MonadFail m, MonadAddContext m, MonadDebug m) =>
String
-> NamesT m Type
-> (NamesT m Term -> NamesT m Type)
-> NamesT m Type
nPi' String
"w" (NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Type
el's NamesT (TCMT IO) Term
a (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
forall a b. (a -> b) -> a -> b
$ TCMT IO Term -> NamesT (TCMT IO) Term
forall (m :: * -> *) a. Monad m => m a -> NamesT m a
cl TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primSub NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> NamesT (TCMT IO) Term
a NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT (TCMT IO) Term
pathxy 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
reflx) ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
 -> NamesT (TCMT IO) Type)
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall a b. (a -> b) -> a -> b
$ \ NamesT (TCMT IO) Term
w ->
        let oucw :: NamesT (TCMT IO) Term
oucw = (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
primSubOut NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> NamesT (TCMT IO) Term
a NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> NamesT (TCMT IO) Term
pathxy 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
reflx 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
w) in
        NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Type
el' NamesT (TCMT IO) Term
c (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
forall a b. (a -> b) -> a -> b
$ NamesT (TCMT IO) Term
bC 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
oucy 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
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
a NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> NamesT (TCMT IO) Term
bA NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> NamesT (TCMT IO) Term
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
oucy 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
oucw))
       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) Type
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall (m :: * -> *).
(MonadFail m, MonadAddContext m, MonadDebug m) =>
String
-> NamesT m Type
-> (NamesT m Term -> NamesT m Type)
-> NamesT m Type
hPi' String
"y" (NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Type
el' NamesT (TCMT IO) Term
a NamesT (TCMT IO) Term
bA) (\ NamesT (TCMT IO) Term
y ->
        String
-> NamesT (TCMT IO) Type
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall (m :: * -> *).
(MonadFail m, MonadAddContext m, MonadDebug m) =>
String
-> NamesT m Type
-> (NamesT m Term -> NamesT m Type)
-> NamesT m Type
nPi' String
"p" (NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Type
el' NamesT (TCMT IO) Term
a (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
forall a b. (a -> b) -> a -> b
$ TCMT IO Term -> NamesT (TCMT IO) Term
forall (m :: * -> *) a. Monad m => m a -> NamesT m a
cl TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primId NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> NamesT (TCMT IO) Term
a NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> NamesT (TCMT IO) Term
bA NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT (TCMT IO) Term
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) Type)
 -> NamesT (TCMT IO) Type)
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall a b. (a -> b) -> a -> b
$ \ NamesT (TCMT IO) Term
p ->
        NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Type
el' NamesT (TCMT IO) Term
c (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
forall a b. (a -> b) -> a -> b
$ NamesT (TCMT IO) Term
bC 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
p)
  Term
conid <- TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primConId
  Term
sin <- TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primSubIn
  Term
path <- TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primPath
  PrimitiveImpl -> TCM PrimitiveImpl
forall (m :: * -> *) a. Monad m => a -> m a
return (PrimitiveImpl -> TCM PrimitiveImpl)
-> PrimitiveImpl -> TCM PrimitiveImpl
forall a b. (a -> b) -> a -> b
$ Type -> PrimFun -> PrimitiveImpl
PrimImpl Type
t (PrimFun -> PrimitiveImpl) -> PrimFun -> PrimitiveImpl
forall a b. (a -> b) -> a -> b
$ QName
-> Arity
-> ([Arg Term] -> ReduceM (Reduced MaybeReducedArgs Term))
-> PrimFun
primFun QName
forall a. HasCallStack => a
__IMPOSSIBLE__ Arity
8 (([Arg Term] -> ReduceM (Reduced MaybeReducedArgs Term))
 -> PrimFun)
-> ([Arg Term] -> ReduceM (Reduced MaybeReducedArgs Term))
-> PrimFun
forall a b. (a -> b) -> a -> b
$ \ [Arg Term]
ts -> do
    case [Arg Term]
ts of
      [Arg Term
a,Arg Term
c,Arg Term
bA,Arg Term
x,Arg Term
bC,Arg Term
f,Arg Term
y,Arg Term
p] -> do
        Blocked (Arg Term)
sp <- Arg Term -> ReduceM (Blocked (Arg Term))
forall t. Reduce t => t -> ReduceM (Blocked t)
reduceB' Arg Term
p
        case Arg Term -> Term
forall e. Arg e -> e
unArg (Arg Term -> Term) -> Arg Term -> Term
forall a b. (a -> b) -> a -> b
$ Blocked (Arg Term) -> Arg Term
forall t a. Blocked' t a -> a
ignoreBlocking Blocked (Arg Term)
sp of
          Def QName
q [Apply Arg Term
_a, Apply Arg Term
_bA, Apply Arg Term
_x, Apply Arg Term
_y, Apply Arg Term
phi , Apply Arg Term
w] -> do
            let y' :: Term
y' = Term
sin Term -> [Arg Term] -> Term
forall t. Apply t => t -> [Arg Term] -> t
`apply` [Arg Term
a,Arg Term
bA                            ,Arg Term
phi,Term -> Arg Term
forall e. e -> Arg e
argN (Term -> Arg Term) -> Term -> Arg Term
forall a b. (a -> b) -> a -> b
$ Arg Term -> Term
forall e. Arg e -> e
unArg Arg Term
y]
            let w' :: Term
w' = Term
sin Term -> [Arg Term] -> Term
forall t. Apply t => t -> [Arg Term] -> t
`apply` [Arg Term
a,Term -> Arg Term
forall e. e -> Arg e
argN (Term -> Arg Term) -> Term -> Arg Term
forall a b. (a -> b) -> a -> b
$ Term
path Term -> [Arg Term] -> Term
forall t. Apply t => t -> [Arg Term] -> t
`apply` [Arg Term
a,Arg Term
bA,Arg Term
x,Arg Term
y],Arg Term
phi,Term -> Arg Term
forall e. e -> Arg e
argN (Term -> Arg Term) -> Term -> Arg Term
forall a b. (a -> b) -> a -> b
$ Arg Term -> Term
forall e. Arg e -> e
unArg Arg Term
w]
            Term -> ReduceM (Reduced MaybeReducedArgs Term)
forall a a'. a -> ReduceM (Reduced a' a)
redReturn (Term -> ReduceM (Reduced MaybeReducedArgs Term))
-> Term -> ReduceM (Reduced MaybeReducedArgs Term)
forall a b. (a -> b) -> a -> b
$ Arg Term -> Term
forall e. Arg e -> e
unArg Arg Term
f Term -> [Arg Term] -> Term
forall t. Apply t => t -> [Arg Term] -> t
`apply` [Arg Term
phi, Term -> Arg Term
forall e. e -> Arg e
defaultArg Term
y', Term -> Arg Term
forall e. e -> Arg e
defaultArg Term
w']
          Term
_ -> Reduced MaybeReducedArgs Term
-> ReduceM (Reduced MaybeReducedArgs Term)
forall (m :: * -> *) a. Monad m => a -> m a
return (Reduced MaybeReducedArgs Term
 -> ReduceM (Reduced MaybeReducedArgs Term))
-> Reduced MaybeReducedArgs Term
-> ReduceM (Reduced MaybeReducedArgs Term)
forall a b. (a -> b) -> a -> b
$ MaybeReducedArgs -> Reduced MaybeReducedArgs Term
forall no yes. no -> Reduced no yes
NoReduction (MaybeReducedArgs -> Reduced MaybeReducedArgs Term)
-> MaybeReducedArgs -> Reduced MaybeReducedArgs Term
forall a b. (a -> b) -> a -> b
$ (Arg Term -> MaybeReduced (Arg Term))
-> [Arg Term] -> MaybeReducedArgs
forall a b. (a -> b) -> [a] -> [b]
map Arg Term -> MaybeReduced (Arg Term)
forall a. a -> MaybeReduced a
notReduced [Arg Term
a,Arg Term
c,Arg Term
bA,Arg Term
x,Arg Term
bC,Arg Term
f,Arg Term
y] MaybeReducedArgs -> MaybeReducedArgs -> MaybeReducedArgs
forall a. [a] -> [a] -> [a]
++ [Blocked (Arg Term) -> MaybeReduced (Arg Term)
reduced Blocked (Arg Term)
sp]
      [Arg Term]
_ -> ReduceM (Reduced MaybeReducedArgs Term)
forall a. HasCallStack => a
__IMPOSSIBLE__


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


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

primPartial' :: TCM PrimitiveImpl
primPartial' :: TCM PrimitiveImpl
primPartial' = do
  Cubical -> String -> TCM ()
requireCubical Cubical
CErased String
""
  Type
t <- Names -> NamesT (TCMT IO) Type -> TCMT IO Type
forall (m :: * -> *) a. Names -> NamesT m a -> m a
runNamesT [] (NamesT (TCMT IO) Type -> TCMT IO Type)
-> NamesT (TCMT IO) Type -> TCMT IO Type
forall a b. (a -> b) -> a -> b
$
       String
-> NamesT (TCMT IO) Type
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall (m :: * -> *).
(MonadFail m, MonadAddContext m, MonadDebug m) =>
String
-> NamesT m Type
-> (NamesT m Term -> NamesT m Type)
-> NamesT m Type
hPi' String
"a" (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
forall (m :: * -> *). Functor m => m Term -> m Type
el (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
forall a b. (a -> b) -> a -> b
$ TCMT IO Term -> NamesT (TCMT IO) Term
forall (m :: * -> *) a. Monad m => m a -> NamesT m a
cl TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primLevel) (\ NamesT (TCMT IO) Term
a ->
        String
-> NamesT (TCMT IO) Type
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall (m :: * -> *).
(MonadFail m, MonadAddContext m, MonadDebug m) =>
String
-> NamesT m Type
-> (NamesT m Term -> NamesT m Type)
-> NamesT m Type
nPi' String
"φ" NamesT (TCMT IO) Type
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Type
primIntervalType ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
 -> NamesT (TCMT IO) Type)
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall a b. (a -> b) -> a -> b
$ \ NamesT (TCMT IO) Term
_ ->
        String
-> NamesT (TCMT IO) Type
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall (m :: * -> *).
(MonadFail m, MonadAddContext m, MonadDebug m) =>
String
-> NamesT m Type
-> (NamesT m Term -> NamesT m Type)
-> NamesT m Type
nPi' String
"A" (Sort' Term -> Type
sort (Sort' Term -> Type) -> (Term -> Sort' Term) -> Term -> Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term -> Sort' Term
tmSort (Term -> Type) -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamesT (TCMT IO) Term
a) ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
 -> NamesT (TCMT IO) Type)
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall a b. (a -> b) -> a -> b
$ \ NamesT (TCMT IO) Term
bA ->
        (Sort' Term -> Type
sort (Sort' Term -> Type) -> (Term -> Sort' Term) -> Term -> Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term -> Sort' Term
tmSSort (Term -> Type) -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamesT (TCMT IO) Term
a))
  Term
isOne <- TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primIsOne
  PrimitiveImpl -> TCM PrimitiveImpl
forall (m :: * -> *) a. Monad m => a -> m a
return (PrimitiveImpl -> TCM PrimitiveImpl)
-> PrimitiveImpl -> TCM PrimitiveImpl
forall a b. (a -> b) -> a -> b
$ Type -> PrimFun -> PrimitiveImpl
PrimImpl Type
t (PrimFun -> PrimitiveImpl) -> PrimFun -> PrimitiveImpl
forall a b. (a -> b) -> a -> b
$ QName
-> Arity
-> ([Arg Term] -> ReduceM (Reduced MaybeReducedArgs Term))
-> PrimFun
primFun QName
forall a. HasCallStack => a
__IMPOSSIBLE__ Arity
3 (([Arg Term] -> ReduceM (Reduced MaybeReducedArgs Term))
 -> PrimFun)
-> ([Arg Term] -> ReduceM (Reduced MaybeReducedArgs Term))
-> PrimFun
forall a b. (a -> b) -> a -> b
$ \ [Arg Term]
ts -> do
    case [Arg Term]
ts of
      [Arg Term
l,Arg Term
phi,Arg Term
a] -> do
          (El Sort' Term
s (Pi Dom Type
d Abs Type
b)) <- Names -> NamesT ReduceM Type -> ReduceM Type
forall (m :: * -> *) a. Names -> NamesT m a -> m a
runNamesT [] (NamesT ReduceM Type -> ReduceM Type)
-> NamesT ReduceM Type -> ReduceM Type
forall a b. (a -> b) -> a -> b
$ do
                             [NamesT ReduceM Term
l,NamesT ReduceM Term
a,NamesT ReduceM Term
phi] <- (Arg Term -> NamesT ReduceM (NamesT ReduceM Term))
-> [Arg Term] -> NamesT ReduceM [NamesT ReduceM Term]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Term -> NamesT ReduceM (NamesT ReduceM Term)
forall (m :: * -> *) a.
(MonadFail m, Subst a) =>
a -> NamesT m (NamesT m a)
open (Term -> NamesT ReduceM (NamesT ReduceM Term))
-> (Arg Term -> Term)
-> Arg Term
-> NamesT ReduceM (NamesT ReduceM Term)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Arg Term -> Term
forall e. Arg e -> e
unArg) [Arg Term
l,Arg Term
a,Arg Term
phi]
                             NamesT ReduceM Term -> NamesT ReduceM Type
forall (m :: * -> *). Functor m => m Term -> m Type
elSSet (Term -> NamesT ReduceM Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
isOne NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT ReduceM Term
phi) NamesT ReduceM Type -> NamesT ReduceM Type -> NamesT ReduceM Type
forall (m :: * -> *). Applicative m => m Type -> m Type -> m Type
--> NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Type
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Type
el' NamesT ReduceM Term
l NamesT ReduceM Term
a
          Term -> ReduceM (Reduced MaybeReducedArgs Term)
forall a a'. a -> ReduceM (Reduced a' a)
redReturn (Term -> ReduceM (Reduced MaybeReducedArgs Term))
-> Term -> ReduceM (Reduced MaybeReducedArgs Term)
forall a b. (a -> b) -> a -> b
$ Dom Type -> Abs Type -> Term
Pi (Relevance -> Dom Type -> Dom Type
forall a. LensRelevance a => Relevance -> a -> a
setRelevance Relevance
Irrelevant (Dom Type -> Dom Type) -> Dom Type -> Dom Type
forall a b. (a -> b) -> a -> b
$ Dom Type
d { domFinite :: Bool
domFinite = Bool
True }) Abs Type
b
      [Arg Term]
_ -> ReduceM (Reduced MaybeReducedArgs Term)
forall a. HasCallStack => a
__IMPOSSIBLE__

primPartialP' :: TCM PrimitiveImpl
primPartialP' :: TCM PrimitiveImpl
primPartialP' = do
  Cubical -> String -> TCM ()
requireCubical Cubical
CErased String
""
  Type
t <- Names -> NamesT (TCMT IO) Type -> TCMT IO Type
forall (m :: * -> *) a. Names -> NamesT m a -> m a
runNamesT [] (NamesT (TCMT IO) Type -> TCMT IO Type)
-> NamesT (TCMT IO) Type -> TCMT IO Type
forall a b. (a -> b) -> a -> b
$
       String
-> NamesT (TCMT IO) Type
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall (m :: * -> *).
(MonadFail m, MonadAddContext m, MonadDebug m) =>
String
-> NamesT m Type
-> (NamesT m Term -> NamesT m Type)
-> NamesT m Type
hPi' String
"a" (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
forall (m :: * -> *). Functor m => m Term -> m Type
el (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
forall a b. (a -> b) -> a -> b
$ TCMT IO Term -> NamesT (TCMT IO) Term
forall (m :: * -> *) a. Monad m => m a -> NamesT m a
cl TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primLevel) (\ NamesT (TCMT IO) Term
a ->
        String
-> NamesT (TCMT IO) Type
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall (m :: * -> *).
(MonadFail m, MonadAddContext m, MonadDebug m) =>
String
-> NamesT m Type
-> (NamesT m Term -> NamesT m Type)
-> NamesT m Type
nPi' String
"φ" NamesT (TCMT IO) Type
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Type
primIntervalType ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
 -> NamesT (TCMT IO) Type)
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall a b. (a -> b) -> a -> b
$ \ NamesT (TCMT IO) Term
phi ->
        String
-> NamesT (TCMT IO) Type
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall (m :: * -> *).
(MonadFail m, MonadAddContext m, MonadDebug m) =>
String
-> NamesT m Type
-> (NamesT m Term -> NamesT m Type)
-> NamesT m Type
nPi' String
"A" (String
-> NamesT (TCMT IO) Term
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall (m :: * -> *).
(MonadAddContext m, HasBuiltins m, MonadDebug m) =>
String
-> NamesT m Term
-> (NamesT m Term -> NamesT m Type)
-> NamesT m Type
pPi' String
"o" NamesT (TCMT IO) Term
phi ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
 -> NamesT (TCMT IO) Type)
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall a b. (a -> b) -> a -> b
$ \ NamesT (TCMT IO) Term
_ -> NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Type
el' (TCMT IO Term -> NamesT (TCMT IO) Term
forall (m :: * -> *) a. Monad m => m a -> NamesT m a
cl TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primLevelSuc NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT (TCMT IO) Term
a) (Sort' Term -> Term
Sort (Sort' Term -> Term) -> (Term -> Sort' Term) -> Term -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term -> Sort' Term
tmSort (Term -> Term) -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamesT (TCMT IO) Term
a)) ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
 -> NamesT (TCMT IO) Type)
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall a b. (a -> b) -> a -> b
$ \ NamesT (TCMT IO) Term
bA ->
        (Sort' Term -> Type
sort (Sort' Term -> Type) -> (Term -> Sort' Term) -> Term -> Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term -> Sort' Term
tmSSort (Term -> Type) -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamesT (TCMT IO) Term
a))
  let toFinitePi :: Type -> Term
      toFinitePi :: Type -> Term
toFinitePi (El Sort' Term
_ (Pi Dom Type
d Abs Type
b)) = Dom Type -> Abs Type -> Term
Pi (Relevance -> Dom Type -> Dom Type
forall a. LensRelevance a => Relevance -> a -> a
setRelevance Relevance
Irrelevant (Dom Type -> Dom Type) -> Dom Type -> Dom Type
forall a b. (a -> b) -> a -> b
$ Dom Type
d { domFinite :: Bool
domFinite = Bool
True }) Abs Type
b
      toFinitePi Type
_               = Term
forall a. HasCallStack => a
__IMPOSSIBLE__
  Term
v <- Names -> NamesT (TCMT IO) Term -> TCMT IO Term
forall (m :: * -> *) a. Names -> NamesT m a -> m a
runNamesT [] (NamesT (TCMT IO) Term -> TCMT IO Term)
-> NamesT (TCMT IO) Term -> 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
"a" ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
 -> NamesT (TCMT IO) Term)
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall a b. (a -> b) -> a -> b
$ \ NamesT (TCMT IO) Term
l ->
        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
"φ" ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
 -> NamesT (TCMT IO) Term)
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall a b. (a -> b) -> a -> b
$ \ NamesT (TCMT IO) Term
phi ->
        String
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
lam String
"A" ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
 -> NamesT (TCMT IO) Term)
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term)
-> NamesT (TCMT IO) Term
forall a b. (a -> b) -> a -> b
$ \ NamesT (TCMT IO) Term
a ->
        Type -> Term
toFinitePi (Type -> Term) -> NamesT (TCMT IO) Type -> NamesT (TCMT IO) Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String
-> NamesT (TCMT IO) Type
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall (m :: * -> *).
(MonadFail m, MonadAddContext m, MonadDebug m) =>
String
-> NamesT m Type
-> (NamesT m Term -> NamesT m Type)
-> NamesT m Type
nPi' String
"p" (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
forall (m :: * -> *). Functor m => m Term -> m Type
elSSet (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
forall a b. (a -> b) -> a -> b
$ TCMT IO Term -> NamesT (TCMT IO) Term
forall (m :: * -> *) a. Monad m => m a -> NamesT m a
cl TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primIsOne 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
p -> NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Type
el' NamesT (TCMT IO) Term
l (NamesT (TCMT IO) Term
a NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT (TCMT IO) Term
p))
  PrimitiveImpl -> TCM PrimitiveImpl
forall (m :: * -> *) a. Monad m => a -> m a
return (PrimitiveImpl -> TCM PrimitiveImpl)
-> PrimitiveImpl -> TCM PrimitiveImpl
forall a b. (a -> b) -> a -> b
$ Type -> PrimFun -> PrimitiveImpl
PrimImpl Type
t (PrimFun -> PrimitiveImpl) -> PrimFun -> PrimitiveImpl
forall a b. (a -> b) -> a -> b
$ QName
-> Arity
-> ([Arg Term] -> ReduceM (Reduced MaybeReducedArgs Term))
-> PrimFun
primFun QName
forall a. HasCallStack => a
__IMPOSSIBLE__ Arity
0 (([Arg Term] -> ReduceM (Reduced MaybeReducedArgs Term))
 -> PrimFun)
-> ([Arg Term] -> ReduceM (Reduced MaybeReducedArgs Term))
-> PrimFun
forall a b. (a -> b) -> a -> b
$ \ [Arg Term]
_ -> Term -> ReduceM (Reduced MaybeReducedArgs Term)
forall a a'. a -> ReduceM (Reduced a' a)
redReturn Term
v

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

primIdFace' :: TCM PrimitiveImpl
primIdFace' :: TCM PrimitiveImpl
primIdFace' = do
  Cubical -> String -> TCM ()
requireCubical Cubical
CErased String
""
  Type
t <- Names -> NamesT (TCMT IO) Type -> TCMT IO Type
forall (m :: * -> *) a. Names -> NamesT m a -> m a
runNamesT [] (NamesT (TCMT IO) Type -> TCMT IO Type)
-> NamesT (TCMT IO) Type -> TCMT IO Type
forall a b. (a -> b) -> a -> b
$
       String
-> NamesT (TCMT IO) Type
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall (m :: * -> *).
(MonadFail m, MonadAddContext m, MonadDebug m) =>
String
-> NamesT m Type
-> (NamesT m Term -> NamesT m Type)
-> NamesT m Type
hPi' String
"a" (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
forall (m :: * -> *). Functor m => m Term -> m Type
el (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
forall a b. (a -> b) -> a -> b
$ TCMT IO Term -> NamesT (TCMT IO) Term
forall (m :: * -> *) a. Monad m => m a -> NamesT m a
cl TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primLevel) ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
 -> NamesT (TCMT IO) Type)
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall a b. (a -> b) -> a -> b
$ \ NamesT (TCMT IO) Term
a ->
       String
-> NamesT (TCMT IO) Type
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall (m :: * -> *).
(MonadFail m, MonadAddContext m, MonadDebug m) =>
String
-> NamesT m Type
-> (NamesT m Term -> NamesT m Type)
-> NamesT m Type
hPi' String
"A" (Sort' Term -> Type
sort (Sort' Term -> Type) -> (Term -> Sort' Term) -> Term -> Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term -> Sort' Term
tmSort (Term -> Type) -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamesT (TCMT IO) Term
a) ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
 -> NamesT (TCMT IO) Type)
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall a b. (a -> b) -> a -> b
$ \ NamesT (TCMT IO) Term
bA ->
       String
-> NamesT (TCMT IO) Type
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall (m :: * -> *).
(MonadFail m, MonadAddContext m, MonadDebug m) =>
String
-> NamesT m Type
-> (NamesT m Term -> NamesT m Type)
-> NamesT m Type
hPi' String
"x" (NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Type
el' NamesT (TCMT IO) Term
a NamesT (TCMT IO) Term
bA) ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
 -> NamesT (TCMT IO) Type)
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall a b. (a -> b) -> a -> b
$ \ NamesT (TCMT IO) Term
x ->
       String
-> NamesT (TCMT IO) Type
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall (m :: * -> *).
(MonadFail m, MonadAddContext m, MonadDebug m) =>
String
-> NamesT m Type
-> (NamesT m Term -> NamesT m Type)
-> NamesT m Type
hPi' String
"y" (NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Type
el' NamesT (TCMT IO) Term
a NamesT (TCMT IO) Term
bA) ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
 -> NamesT (TCMT IO) Type)
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall a b. (a -> b) -> a -> b
$ \ NamesT (TCMT IO) Term
y ->
       NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Type
el' NamesT (TCMT IO) Term
a (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
primId NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> NamesT (TCMT IO) Term
a NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> NamesT (TCMT IO) Term
bA NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT (TCMT IO) Term
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) Type
-> NamesT (TCMT IO) Type -> NamesT (TCMT IO) Type
forall (m :: * -> *). Applicative m => m Type -> m Type -> m Type
--> NamesT (TCMT IO) Type
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Type
primIntervalType
  PrimitiveImpl -> TCM PrimitiveImpl
forall (m :: * -> *) a. Monad m => a -> m a
return (PrimitiveImpl -> TCM PrimitiveImpl)
-> PrimitiveImpl -> TCM PrimitiveImpl
forall a b. (a -> b) -> a -> b
$ Type -> PrimFun -> PrimitiveImpl
PrimImpl Type
t (PrimFun -> PrimitiveImpl) -> PrimFun -> PrimitiveImpl
forall a b. (a -> b) -> a -> b
$ QName
-> Arity
-> ([Arg Term] -> ReduceM (Reduced MaybeReducedArgs Term))
-> PrimFun
primFun QName
forall a. HasCallStack => a
__IMPOSSIBLE__ Arity
5 (([Arg Term] -> ReduceM (Reduced MaybeReducedArgs Term))
 -> PrimFun)
-> ([Arg Term] -> ReduceM (Reduced MaybeReducedArgs Term))
-> PrimFun
forall a b. (a -> b) -> a -> b
$ \ [Arg Term]
ts -> do
    case [Arg Term]
ts of
      [Arg Term
l,Arg Term
bA,Arg Term
x,Arg Term
y,Arg Term
t] -> do
        Blocked (Arg Term)
st <- Arg Term -> ReduceM (Blocked (Arg Term))
forall t. Reduce t => t -> ReduceM (Blocked t)
reduceB' Arg Term
t
        Maybe QName
mConId <- String -> ReduceM (Maybe QName)
forall (m :: * -> *). HasBuiltins m => String -> m (Maybe QName)
getName' String
builtinConId
        case Arg Term -> Term
forall e. Arg e -> e
unArg (Blocked (Arg Term) -> Arg Term
forall t a. Blocked' t a -> a
ignoreBlocking Blocked (Arg Term)
st) of
          Def QName
q [Elim
_,Elim
_,Elim
_,Elim
_, Apply Arg Term
phi,Elim
_] | QName -> Maybe QName
forall a. a -> Maybe a
Just QName
q Maybe QName -> Maybe QName -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe QName
mConId -> Term -> ReduceM (Reduced MaybeReducedArgs Term)
forall a a'. a -> ReduceM (Reduced a' a)
redReturn (Arg Term -> Term
forall e. Arg e -> e
unArg Arg Term
phi)
          Term
_ -> Reduced MaybeReducedArgs Term
-> ReduceM (Reduced MaybeReducedArgs Term)
forall (m :: * -> *) a. Monad m => a -> m a
return (Reduced MaybeReducedArgs Term
 -> ReduceM (Reduced MaybeReducedArgs Term))
-> Reduced MaybeReducedArgs Term
-> ReduceM (Reduced MaybeReducedArgs Term)
forall a b. (a -> b) -> a -> b
$ MaybeReducedArgs -> Reduced MaybeReducedArgs Term
forall no yes. no -> Reduced no yes
NoReduction (MaybeReducedArgs -> Reduced MaybeReducedArgs Term)
-> MaybeReducedArgs -> Reduced MaybeReducedArgs Term
forall a b. (a -> b) -> a -> b
$ (Arg Term -> MaybeReduced (Arg Term))
-> [Arg Term] -> MaybeReducedArgs
forall a b. (a -> b) -> [a] -> [b]
map Arg Term -> MaybeReduced (Arg Term)
forall a. a -> MaybeReduced a
notReduced [Arg Term
l,Arg Term
bA,Arg Term
x,Arg Term
y] MaybeReducedArgs -> MaybeReducedArgs -> MaybeReducedArgs
forall a. [a] -> [a] -> [a]
++ [Blocked (Arg Term) -> MaybeReduced (Arg Term)
reduced Blocked (Arg Term)
st]
      [Arg Term]
_ -> ReduceM (Reduced MaybeReducedArgs Term)
forall a. HasCallStack => a
__IMPOSSIBLE__

primIdPath' :: TCM PrimitiveImpl
primIdPath' :: TCM PrimitiveImpl
primIdPath' = do
  Cubical -> String -> TCM ()
requireCubical Cubical
CErased String
""
  Type
t <- Names -> NamesT (TCMT IO) Type -> TCMT IO Type
forall (m :: * -> *) a. Names -> NamesT m a -> m a
runNamesT [] (NamesT (TCMT IO) Type -> TCMT IO Type)
-> NamesT (TCMT IO) Type -> TCMT IO Type
forall a b. (a -> b) -> a -> b
$
       String
-> NamesT (TCMT IO) Type
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall (m :: * -> *).
(MonadFail m, MonadAddContext m, MonadDebug m) =>
String
-> NamesT m Type
-> (NamesT m Term -> NamesT m Type)
-> NamesT m Type
hPi' String
"a" (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
forall (m :: * -> *). Functor m => m Term -> m Type
el (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
forall a b. (a -> b) -> a -> b
$ TCMT IO Term -> NamesT (TCMT IO) Term
forall (m :: * -> *) a. Monad m => m a -> NamesT m a
cl TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primLevel) ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
 -> NamesT (TCMT IO) Type)
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall a b. (a -> b) -> a -> b
$ \ NamesT (TCMT IO) Term
a ->
       String
-> NamesT (TCMT IO) Type
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall (m :: * -> *).
(MonadFail m, MonadAddContext m, MonadDebug m) =>
String
-> NamesT m Type
-> (NamesT m Term -> NamesT m Type)
-> NamesT m Type
hPi' String
"A" (Sort' Term -> Type
sort (Sort' Term -> Type) -> (Term -> Sort' Term) -> Term -> Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term -> Sort' Term
tmSort (Term -> Type) -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamesT (TCMT IO) Term
a) ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
 -> NamesT (TCMT IO) Type)
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall a b. (a -> b) -> a -> b
$ \ NamesT (TCMT IO) Term
bA ->
       String
-> NamesT (TCMT IO) Type
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall (m :: * -> *).
(MonadFail m, MonadAddContext m, MonadDebug m) =>
String
-> NamesT m Type
-> (NamesT m Term -> NamesT m Type)
-> NamesT m Type
hPi' String
"x" (NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Type
el' NamesT (TCMT IO) Term
a NamesT (TCMT IO) Term
bA) ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
 -> NamesT (TCMT IO) Type)
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall a b. (a -> b) -> a -> b
$ \ NamesT (TCMT IO) Term
x ->
       String
-> NamesT (TCMT IO) Type
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall (m :: * -> *).
(MonadFail m, MonadAddContext m, MonadDebug m) =>
String
-> NamesT m Type
-> (NamesT m Term -> NamesT m Type)
-> NamesT m Type
hPi' String
"y" (NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Type
el' NamesT (TCMT IO) Term
a NamesT (TCMT IO) Term
bA) ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
 -> NamesT (TCMT IO) Type)
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall a b. (a -> b) -> a -> b
$ \ NamesT (TCMT IO) Term
y ->
       NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Type
el' NamesT (TCMT IO) Term
a (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
primId NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> NamesT (TCMT IO) Term
a NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> NamesT (TCMT IO) Term
bA NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT (TCMT IO) Term
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) Type
-> NamesT (TCMT IO) Type -> NamesT (TCMT IO) Type
forall (m :: * -> *). Applicative m => m Type -> m Type -> m Type
--> NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Type
el' NamesT (TCMT IO) Term
a (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
primPath NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> NamesT (TCMT IO) Term
a NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> NamesT (TCMT IO) Term
bA NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT (TCMT IO) Term
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)
  PrimitiveImpl -> TCM PrimitiveImpl
forall (m :: * -> *) a. Monad m => a -> m a
return (PrimitiveImpl -> TCM PrimitiveImpl)
-> PrimitiveImpl -> TCM PrimitiveImpl
forall a b. (a -> b) -> a -> b
$ Type -> PrimFun -> PrimitiveImpl
PrimImpl Type
t (PrimFun -> PrimitiveImpl) -> PrimFun -> PrimitiveImpl
forall a b. (a -> b) -> a -> b
$ QName
-> Arity
-> ([Arg Term] -> ReduceM (Reduced MaybeReducedArgs Term))
-> PrimFun
primFun QName
forall a. HasCallStack => a
__IMPOSSIBLE__ Arity
5 (([Arg Term] -> ReduceM (Reduced MaybeReducedArgs Term))
 -> PrimFun)
-> ([Arg Term] -> ReduceM (Reduced MaybeReducedArgs Term))
-> PrimFun
forall a b. (a -> b) -> a -> b
$ \ [Arg Term]
ts -> do
    case [Arg Term]
ts of
      [Arg Term
l,Arg Term
bA,Arg Term
x,Arg Term
y,Arg Term
t] -> do
        Blocked (Arg Term)
st <- Arg Term -> ReduceM (Blocked (Arg Term))
forall t. Reduce t => t -> ReduceM (Blocked t)
reduceB' Arg Term
t
        Maybe QName
mConId <- String -> ReduceM (Maybe QName)
forall (m :: * -> *). HasBuiltins m => String -> m (Maybe QName)
getName' String
builtinConId
        case Arg Term -> Term
forall e. Arg e -> e
unArg (Blocked (Arg Term) -> Arg Term
forall t a. Blocked' t a -> a
ignoreBlocking Blocked (Arg Term)
st) of
          Def QName
q [Elim
_,Elim
_,Elim
_,Elim
_,Elim
_,Apply Arg Term
w] | QName -> Maybe QName
forall a. a -> Maybe a
Just QName
q Maybe QName -> Maybe QName -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe QName
mConId -> Term -> ReduceM (Reduced MaybeReducedArgs Term)
forall a a'. a -> ReduceM (Reduced a' a)
redReturn (Arg Term -> Term
forall e. Arg e -> e
unArg Arg Term
w)
          Term
_ -> Reduced MaybeReducedArgs Term
-> ReduceM (Reduced MaybeReducedArgs Term)
forall (m :: * -> *) a. Monad m => a -> m a
return (Reduced MaybeReducedArgs Term
 -> ReduceM (Reduced MaybeReducedArgs Term))
-> Reduced MaybeReducedArgs Term
-> ReduceM (Reduced MaybeReducedArgs Term)
forall a b. (a -> b) -> a -> b
$ MaybeReducedArgs -> Reduced MaybeReducedArgs Term
forall no yes. no -> Reduced no yes
NoReduction (MaybeReducedArgs -> Reduced MaybeReducedArgs Term)
-> MaybeReducedArgs -> Reduced MaybeReducedArgs Term
forall a b. (a -> b) -> a -> b
$ (Arg Term -> MaybeReduced (Arg Term))
-> [Arg Term] -> MaybeReducedArgs
forall a b. (a -> b) -> [a] -> [b]
map Arg Term -> MaybeReduced (Arg Term)
forall a. a -> MaybeReduced a
notReduced [Arg Term
l,Arg Term
bA,Arg Term
x,Arg Term
y] MaybeReducedArgs -> MaybeReducedArgs -> MaybeReducedArgs
forall a. [a] -> [a] -> [a]
++ [Blocked (Arg Term) -> MaybeReduced (Arg Term)
reduced Blocked (Arg Term)
st]
      [Arg Term]
_ -> ReduceM (Reduced MaybeReducedArgs Term)
forall a. HasCallStack => a
__IMPOSSIBLE__


primTrans' :: TCM PrimitiveImpl
primTrans' :: TCM PrimitiveImpl
primTrans' = do
  Cubical -> String -> TCM ()
requireCubical Cubical
CErased String
""
  Type
t    <- Names -> NamesT (TCMT IO) Type -> TCMT IO Type
forall (m :: * -> *) a. Names -> NamesT m a -> m a
runNamesT [] (NamesT (TCMT IO) Type -> TCMT IO Type)
-> NamesT (TCMT IO) Type -> TCMT IO Type
forall a b. (a -> b) -> a -> b
$
          String
-> NamesT (TCMT IO) Type
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall (m :: * -> *).
(MonadFail m, MonadAddContext m, MonadDebug m) =>
String
-> NamesT m Type
-> (NamesT m Term -> NamesT m Type)
-> NamesT m Type
hPi' String
"a" (NamesT (TCMT IO) Type
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Type
primIntervalType NamesT (TCMT IO) Type
-> NamesT (TCMT IO) Type -> NamesT (TCMT IO) Type
forall (m :: * -> *). Applicative m => m Type -> m Type -> m Type
--> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
forall (m :: * -> *). Functor m => m Term -> m Type
el (TCMT IO Term -> NamesT (TCMT IO) Term
forall (m :: * -> *) a. Monad m => m a -> NamesT m a
cl TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primLevel)) ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
 -> NamesT (TCMT IO) Type)
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall a b. (a -> b) -> a -> b
$ \ NamesT (TCMT IO) Term
a ->
          String
-> NamesT (TCMT IO) Type
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall (m :: * -> *).
(MonadFail m, MonadAddContext m, MonadDebug m) =>
String
-> NamesT m Type
-> (NamesT m Term -> NamesT m Type)
-> NamesT m Type
nPi' String
"A" (String
-> NamesT (TCMT IO) Type
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall (m :: * -> *).
(MonadFail m, MonadAddContext m, MonadDebug m) =>
String
-> NamesT m Type
-> (NamesT m Term -> NamesT m Type)
-> NamesT m Type
nPi' String
"i" NamesT (TCMT IO) Type
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Type
primIntervalType ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
 -> NamesT (TCMT IO) Type)
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall a b. (a -> b) -> a -> b
$ \ NamesT (TCMT IO) Term
i -> (Sort' Term -> Type
sort (Sort' Term -> Type) -> (Term -> Sort' Term) -> Term -> Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term -> Sort' Term
tmSort (Term -> Type) -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (NamesT (TCMT IO) Term
a NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT (TCMT IO) Term
i))) ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
 -> NamesT (TCMT IO) Type)
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall a b. (a -> b) -> a -> b
$ \ NamesT (TCMT IO) Term
bA ->
          String
-> NamesT (TCMT IO) Type
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall (m :: * -> *).
(MonadFail m, MonadAddContext m, MonadDebug m) =>
String
-> NamesT m Type
-> (NamesT m Term -> NamesT m Type)
-> NamesT m Type
nPi' String
"φ" NamesT (TCMT IO) Type
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Type
primIntervalType ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
 -> NamesT (TCMT IO) Type)
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall a b. (a -> b) -> a -> b
$ \ NamesT (TCMT IO) Term
phi ->
          (NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Type
el' (NamesT (TCMT IO) Term
a NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> TCMT IO Term -> NamesT (TCMT IO) Term
forall (m :: * -> *) a. Monad m => m a -> NamesT m a
cl TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primIZero) (NamesT (TCMT IO) Term
bA NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> TCMT IO Term -> NamesT (TCMT IO) Term
forall (m :: * -> *) a. Monad m => m a -> NamesT m a
cl TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primIZero) NamesT (TCMT IO) Type
-> NamesT (TCMT IO) Type -> NamesT (TCMT IO) Type
forall (m :: * -> *). Applicative m => m Type -> m Type -> m Type
--> NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Type
el' (NamesT (TCMT IO) Term
a NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> TCMT IO Term -> NamesT (TCMT IO) Term
forall (m :: * -> *) a. Monad m => m a -> NamesT m a
cl TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primIOne) (NamesT (TCMT IO) Term
bA NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> TCMT IO Term -> NamesT (TCMT IO) Term
forall (m :: * -> *) a. Monad m => m a -> NamesT m a
cl TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primIOne))
  PrimitiveImpl -> TCM PrimitiveImpl
forall (m :: * -> *) a. Monad m => a -> m a
return (PrimitiveImpl -> TCM PrimitiveImpl)
-> PrimitiveImpl -> TCM PrimitiveImpl
forall a b. (a -> b) -> a -> b
$ Type -> PrimFun -> PrimitiveImpl
PrimImpl Type
t (PrimFun -> PrimitiveImpl) -> PrimFun -> PrimitiveImpl
forall a b. (a -> b) -> a -> b
$ QName
-> Arity
-> ([Arg Term] -> Arity -> ReduceM (Reduced MaybeReducedArgs Term))
-> PrimFun
PrimFun QName
forall a. HasCallStack => a
__IMPOSSIBLE__ Arity
4 (([Arg Term] -> Arity -> ReduceM (Reduced MaybeReducedArgs Term))
 -> PrimFun)
-> ([Arg Term] -> Arity -> ReduceM (Reduced MaybeReducedArgs Term))
-> PrimFun
forall a b. (a -> b) -> a -> b
$ \ [Arg Term]
ts Arity
nelims -> do
    TranspOrHComp
-> [Arg Term] -> Arity -> ReduceM (Reduced MaybeReducedArgs Term)
primTransHComp TranspOrHComp
DoTransp [Arg Term]
ts Arity
nelims

primHComp' :: TCM PrimitiveImpl
primHComp' :: TCM PrimitiveImpl
primHComp' = do
  Cubical -> String -> TCM ()
requireCubical Cubical
CErased String
""
  Type
t    <- Names -> NamesT (TCMT IO) Type -> TCMT IO Type
forall (m :: * -> *) a. Names -> NamesT m a -> m a
runNamesT [] (NamesT (TCMT IO) Type -> TCMT IO Type)
-> NamesT (TCMT IO) Type -> TCMT IO Type
forall a b. (a -> b) -> a -> b
$
          String
-> NamesT (TCMT IO) Type
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall (m :: * -> *).
(MonadFail m, MonadAddContext m, MonadDebug m) =>
String
-> NamesT m Type
-> (NamesT m Term -> NamesT m Type)
-> NamesT m Type
hPi' String
"a" (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
forall (m :: * -> *). Functor m => m Term -> m Type
el (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
forall a b. (a -> b) -> a -> b
$ TCMT IO Term -> NamesT (TCMT IO) Term
forall (m :: * -> *) a. Monad m => m a -> NamesT m a
cl TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primLevel) ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
 -> NamesT (TCMT IO) Type)
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall a b. (a -> b) -> a -> b
$ \ NamesT (TCMT IO) Term
a ->
          String
-> NamesT (TCMT IO) Type
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall (m :: * -> *).
(MonadFail m, MonadAddContext m, MonadDebug m) =>
String
-> NamesT m Type
-> (NamesT m Term -> NamesT m Type)
-> NamesT m Type
hPi' String
"A" (Sort' Term -> Type
sort (Sort' Term -> Type) -> (Term -> Sort' Term) -> Term -> Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term -> Sort' Term
tmSort (Term -> Type) -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamesT (TCMT IO) Term
a) ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
 -> NamesT (TCMT IO) Type)
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall a b. (a -> b) -> a -> b
$ \ NamesT (TCMT IO) Term
bA ->
          String
-> NamesT (TCMT IO) Type
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall (m :: * -> *).
(MonadFail m, MonadAddContext m, MonadDebug m) =>
String
-> NamesT m Type
-> (NamesT m Term -> NamesT m Type)
-> NamesT m Type
hPi' String
"φ" NamesT (TCMT IO) Type
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Type
primIntervalType ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
 -> NamesT (TCMT IO) Type)
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall a b. (a -> b) -> a -> b
$ \ NamesT (TCMT IO) Term
phi ->
          String
-> NamesT (TCMT IO) Type
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall (m :: * -> *).
(MonadFail m, MonadAddContext m, MonadDebug m) =>
String
-> NamesT m Type
-> (NamesT m Term -> NamesT m Type)
-> NamesT m Type
nPi' String
"i" NamesT (TCMT IO) Type
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Type
primIntervalType (\ NamesT (TCMT IO) Term
i -> String
-> NamesT (TCMT IO) Term
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall (m :: * -> *).
(MonadAddContext m, HasBuiltins m, MonadDebug m) =>
String
-> NamesT m Term
-> (NamesT m Term -> NamesT m Type)
-> NamesT m Type
pPi' String
"o" NamesT (TCMT IO) Term
phi ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
 -> NamesT (TCMT IO) Type)
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall a b. (a -> b) -> a -> b
$ \ NamesT (TCMT IO) Term
_ -> NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Type
el' NamesT (TCMT IO) Term
a NamesT (TCMT IO) Term
bA) NamesT (TCMT IO) Type
-> NamesT (TCMT IO) Type -> NamesT (TCMT IO) Type
forall (m :: * -> *). Applicative m => m Type -> m Type -> m Type
-->
          (NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Type
el' NamesT (TCMT IO) Term
a NamesT (TCMT IO) Term
bA NamesT (TCMT IO) Type
-> NamesT (TCMT IO) Type -> NamesT (TCMT IO) Type
forall (m :: * -> *). Applicative m => m Type -> m Type -> m Type
--> NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Type
el' NamesT (TCMT IO) Term
a NamesT (TCMT IO) Term
bA)
  PrimitiveImpl -> TCM PrimitiveImpl
forall (m :: * -> *) a. Monad m => a -> m a
return (PrimitiveImpl -> TCM PrimitiveImpl)
-> PrimitiveImpl -> TCM PrimitiveImpl
forall a b. (a -> b) -> a -> b
$ Type -> PrimFun -> PrimitiveImpl
PrimImpl Type
t (PrimFun -> PrimitiveImpl) -> PrimFun -> PrimitiveImpl
forall a b. (a -> b) -> a -> b
$ QName
-> Arity
-> ([Arg Term] -> Arity -> ReduceM (Reduced MaybeReducedArgs Term))
-> PrimFun
PrimFun QName
forall a. HasCallStack => a
__IMPOSSIBLE__ Arity
5 (([Arg Term] -> Arity -> ReduceM (Reduced MaybeReducedArgs Term))
 -> PrimFun)
-> ([Arg Term] -> Arity -> ReduceM (Reduced MaybeReducedArgs Term))
-> PrimFun
forall a b. (a -> b) -> a -> b
$ \ [Arg Term]
ts Arity
nelims -> do
    TranspOrHComp
-> [Arg Term] -> Arity -> ReduceM (Reduced MaybeReducedArgs Term)
primTransHComp TranspOrHComp
DoHComp [Arg Term]
ts Arity
nelims

data TranspOrHComp = DoTransp | DoHComp deriving (TranspOrHComp -> TranspOrHComp -> Bool
(TranspOrHComp -> TranspOrHComp -> Bool)
-> (TranspOrHComp -> TranspOrHComp -> Bool) -> Eq TranspOrHComp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TranspOrHComp -> TranspOrHComp -> Bool
$c/= :: TranspOrHComp -> TranspOrHComp -> Bool
== :: TranspOrHComp -> TranspOrHComp -> Bool
$c== :: TranspOrHComp -> TranspOrHComp -> Bool
Eq,Arity -> TranspOrHComp -> String -> String
[TranspOrHComp] -> String -> String
TranspOrHComp -> String
(Arity -> TranspOrHComp -> String -> String)
-> (TranspOrHComp -> String)
-> ([TranspOrHComp] -> String -> String)
-> Show TranspOrHComp
forall a.
(Arity -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [TranspOrHComp] -> String -> String
$cshowList :: [TranspOrHComp] -> String -> String
show :: TranspOrHComp -> String
$cshow :: TranspOrHComp -> String
showsPrec :: Arity -> TranspOrHComp -> String -> String
$cshowsPrec :: Arity -> TranspOrHComp -> String -> String
Show)

cmdToName :: TranspOrHComp -> String
cmdToName :: TranspOrHComp -> String
cmdToName TranspOrHComp
DoTransp = String
builtinTrans
cmdToName TranspOrHComp
DoHComp  = String
builtinHComp

data FamilyOrNot a
  = IsFam { FamilyOrNot a -> a
famThing :: a }
  | IsNot { famThing :: a }
  deriving (FamilyOrNot a -> FamilyOrNot a -> Bool
(FamilyOrNot a -> FamilyOrNot a -> Bool)
-> (FamilyOrNot a -> FamilyOrNot a -> Bool) -> Eq (FamilyOrNot a)
forall a. Eq a => FamilyOrNot a -> FamilyOrNot a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FamilyOrNot a -> FamilyOrNot a -> Bool
$c/= :: forall a. Eq a => FamilyOrNot a -> FamilyOrNot a -> Bool
== :: FamilyOrNot a -> FamilyOrNot a -> Bool
$c== :: forall a. Eq a => FamilyOrNot a -> FamilyOrNot a -> Bool
Eq,Arity -> FamilyOrNot a -> String -> String
[FamilyOrNot a] -> String -> String
FamilyOrNot a -> String
(Arity -> FamilyOrNot a -> String -> String)
-> (FamilyOrNot a -> String)
-> ([FamilyOrNot a] -> String -> String)
-> Show (FamilyOrNot a)
forall a. Show a => Arity -> FamilyOrNot a -> String -> String
forall a. Show a => [FamilyOrNot a] -> String -> String
forall a. Show a => FamilyOrNot a -> String
forall a.
(Arity -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [FamilyOrNot a] -> String -> String
$cshowList :: forall a. Show a => [FamilyOrNot a] -> String -> String
show :: FamilyOrNot a -> String
$cshow :: forall a. Show a => FamilyOrNot a -> String
showsPrec :: Arity -> FamilyOrNot a -> String -> String
$cshowsPrec :: forall a. Show a => Arity -> FamilyOrNot a -> String -> String
Show,a -> FamilyOrNot b -> FamilyOrNot a
(a -> b) -> FamilyOrNot a -> FamilyOrNot b
(forall a b. (a -> b) -> FamilyOrNot a -> FamilyOrNot b)
-> (forall a b. a -> FamilyOrNot b -> FamilyOrNot a)
-> Functor FamilyOrNot
forall a b. a -> FamilyOrNot b -> FamilyOrNot a
forall a b. (a -> b) -> FamilyOrNot a -> FamilyOrNot b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> FamilyOrNot b -> FamilyOrNot a
$c<$ :: forall a b. a -> FamilyOrNot b -> FamilyOrNot a
fmap :: (a -> b) -> FamilyOrNot a -> FamilyOrNot b
$cfmap :: forall a b. (a -> b) -> FamilyOrNot a -> FamilyOrNot b
Functor,FamilyOrNot a -> Bool
(a -> m) -> FamilyOrNot a -> m
(a -> b -> b) -> b -> FamilyOrNot a -> b
(forall m. Monoid m => FamilyOrNot m -> m)
-> (forall m a. Monoid m => (a -> m) -> FamilyOrNot a -> m)
-> (forall m a. Monoid m => (a -> m) -> FamilyOrNot a -> m)
-> (forall a b. (a -> b -> b) -> b -> FamilyOrNot a -> b)
-> (forall a b. (a -> b -> b) -> b -> FamilyOrNot a -> b)
-> (forall b a. (b -> a -> b) -> b -> FamilyOrNot a -> b)
-> (forall b a. (b -> a -> b) -> b -> FamilyOrNot a -> b)
-> (forall a. (a -> a -> a) -> FamilyOrNot a -> a)
-> (forall a. (a -> a -> a) -> FamilyOrNot a -> a)
-> (forall a. FamilyOrNot a -> [a])
-> (forall a. FamilyOrNot a -> Bool)
-> (forall a. FamilyOrNot a -> Arity)
-> (forall a. Eq a => a -> FamilyOrNot a -> Bool)
-> (forall a. Ord a => FamilyOrNot a -> a)
-> (forall a. Ord a => FamilyOrNot a -> a)
-> (forall a. Num a => FamilyOrNot a -> a)
-> (forall a. Num a => FamilyOrNot a -> a)
-> Foldable FamilyOrNot
forall a. Eq a => a -> FamilyOrNot a -> Bool
forall a. Num a => FamilyOrNot a -> a
forall a. Ord a => FamilyOrNot a -> a
forall m. Monoid m => FamilyOrNot m -> m
forall a. FamilyOrNot a -> Bool
forall a. FamilyOrNot a -> Arity
forall a. FamilyOrNot a -> [a]
forall a. (a -> a -> a) -> FamilyOrNot a -> a
forall m a. Monoid m => (a -> m) -> FamilyOrNot a -> m
forall b a. (b -> a -> b) -> b -> FamilyOrNot a -> b
forall a b. (a -> b -> b) -> b -> FamilyOrNot a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Arity)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: FamilyOrNot a -> a
$cproduct :: forall a. Num a => FamilyOrNot a -> a
sum :: FamilyOrNot a -> a
$csum :: forall a. Num a => FamilyOrNot a -> a
minimum :: FamilyOrNot a -> a
$cminimum :: forall a. Ord a => FamilyOrNot a -> a
maximum :: FamilyOrNot a -> a
$cmaximum :: forall a. Ord a => FamilyOrNot a -> a
elem :: a -> FamilyOrNot a -> Bool
$celem :: forall a. Eq a => a -> FamilyOrNot a -> Bool
length :: FamilyOrNot a -> Arity
$clength :: forall a. FamilyOrNot a -> Arity
null :: FamilyOrNot a -> Bool
$cnull :: forall a. FamilyOrNot a -> Bool
toList :: FamilyOrNot a -> [a]
$ctoList :: forall a. FamilyOrNot a -> [a]
foldl1 :: (a -> a -> a) -> FamilyOrNot a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> FamilyOrNot a -> a
foldr1 :: (a -> a -> a) -> FamilyOrNot a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> FamilyOrNot a -> a
foldl' :: (b -> a -> b) -> b -> FamilyOrNot a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> FamilyOrNot a -> b
foldl :: (b -> a -> b) -> b -> FamilyOrNot a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> FamilyOrNot a -> b
foldr' :: (a -> b -> b) -> b -> FamilyOrNot a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> FamilyOrNot a -> b
foldr :: (a -> b -> b) -> b -> FamilyOrNot a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> FamilyOrNot a -> b
foldMap' :: (a -> m) -> FamilyOrNot a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> FamilyOrNot a -> m
foldMap :: (a -> m) -> FamilyOrNot a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> FamilyOrNot a -> m
fold :: FamilyOrNot m -> m
$cfold :: forall m. Monoid m => FamilyOrNot m -> m
Foldable,Functor FamilyOrNot
Foldable FamilyOrNot
Functor FamilyOrNot
-> Foldable FamilyOrNot
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> FamilyOrNot a -> f (FamilyOrNot b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    FamilyOrNot (f a) -> f (FamilyOrNot a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> FamilyOrNot a -> m (FamilyOrNot b))
-> (forall (m :: * -> *) a.
    Monad m =>
    FamilyOrNot (m a) -> m (FamilyOrNot a))
-> Traversable FamilyOrNot
(a -> f b) -> FamilyOrNot a -> f (FamilyOrNot b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
FamilyOrNot (m a) -> m (FamilyOrNot a)
forall (f :: * -> *) a.
Applicative f =>
FamilyOrNot (f a) -> f (FamilyOrNot a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> FamilyOrNot a -> m (FamilyOrNot b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> FamilyOrNot a -> f (FamilyOrNot b)
sequence :: FamilyOrNot (m a) -> m (FamilyOrNot a)
$csequence :: forall (m :: * -> *) a.
Monad m =>
FamilyOrNot (m a) -> m (FamilyOrNot a)
mapM :: (a -> m b) -> FamilyOrNot a -> m (FamilyOrNot b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> FamilyOrNot a -> m (FamilyOrNot b)
sequenceA :: FamilyOrNot (f a) -> f (FamilyOrNot a)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
FamilyOrNot (f a) -> f (FamilyOrNot a)
traverse :: (a -> f b) -> FamilyOrNot a -> f (FamilyOrNot b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> FamilyOrNot a -> f (FamilyOrNot b)
$cp2Traversable :: Foldable FamilyOrNot
$cp1Traversable :: Functor FamilyOrNot
Traversable)

instance Reduce a => Reduce (FamilyOrNot a) where
  reduceB' :: FamilyOrNot a -> ReduceM (Blocked (FamilyOrNot a))
reduceB' FamilyOrNot a
x = (Blocked' Term a -> Blocked' Term a)
-> FamilyOrNot (Blocked' Term a) -> Blocked (FamilyOrNot a)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Blocked' Term a -> Blocked' Term a
forall a. a -> a
id (FamilyOrNot (Blocked' Term a) -> Blocked (FamilyOrNot a))
-> ReduceM (FamilyOrNot (Blocked' Term a))
-> ReduceM (Blocked (FamilyOrNot a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> ReduceM (Blocked' Term a))
-> FamilyOrNot a -> ReduceM (FamilyOrNot (Blocked' Term a))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> ReduceM (Blocked' Term a)
forall t. Reduce t => t -> ReduceM (Blocked t)
reduceB' FamilyOrNot a
x
  reduce' :: FamilyOrNot a -> ReduceM (FamilyOrNot a)
reduce' FamilyOrNot a
x = (a -> ReduceM a) -> FamilyOrNot a -> ReduceM (FamilyOrNot a)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> ReduceM a
forall t. Reduce t => t -> ReduceM t
reduce' FamilyOrNot a
x


-- | Define a "ghcomp" version of gcomp. Normal comp looks like:
--
-- comp^i A [ phi -> u ] u0 = hcomp^i A(1/i) [ phi -> forward A i u ] (forward A 0 u0)
--
-- So for "gcomp" we compute:
--
-- gcomp^i A [ phi -> u ] u0 = hcomp^i A(1/i) [ phi -> forward A i u, ~ phi -> forward A 0 u0 ] (forward A 0 u0)
--
-- The point of this is that gcomp does not produce any empty
-- systems (if phi = 0 it will reduce to "forward A 0 u".
mkGComp :: HasBuiltins m => String -> NamesT m (NamesT m Term -> NamesT m Term -> NamesT m Term -> NamesT m Term -> NamesT m Term -> NamesT m Term)
mkGComp :: String
-> NamesT
     m
     (NamesT m Term
      -> NamesT m Term
      -> NamesT m Term
      -> NamesT m Term
      -> NamesT m Term
      -> NamesT m Term)
mkGComp String
s = do
  let getTermLocal :: String -> NamesT m Term
getTermLocal = String -> String -> NamesT m Term
forall (m :: * -> *). HasBuiltins m => String -> String -> m Term
getTerm String
s
  Term
tPOr <- String -> NamesT m Term
getTermLocal String
"primPOr"
  Term
tIMax <- String -> NamesT m Term
getTermLocal String
builtinIMax
  Term
tIMin <- String -> NamesT m Term
getTermLocal String
builtinIMin
  Term
tINeg <- String -> NamesT m Term
getTermLocal String
builtinINeg
  Term
tHComp <- String -> NamesT m Term
getTermLocal String
builtinHComp
  Term
tTrans <- String -> NamesT m Term
getTermLocal String
builtinTrans
  Term
io      <- String -> NamesT m Term
getTermLocal String
builtinIOne
  Term
iz      <- String -> NamesT m Term
getTermLocal String
builtinIZero
  let ineg :: NamesT m Term -> NamesT m Term
ineg NamesT m Term
j = Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
tINeg NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT m Term
j
      imax :: NamesT m Term -> NamesT m Term -> NamesT m Term
imax NamesT m Term
i NamesT m Term
j = Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
tIMax 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 forward :: NamesT m Term
-> NamesT m Term -> NamesT m Term -> NamesT m Term -> NamesT m Term
forward NamesT m Term
la NamesT m Term
bA NamesT m Term
r NamesT m Term
u = Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
tTrans NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
lam String
"i" (\ NamesT m Term
i -> NamesT m Term
la NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> (NamesT m Term
i NamesT m Term -> NamesT m Term -> NamesT m Term
`imax` NamesT m Term
r))
                                      NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
lam String
"i" (\ NamesT m Term
i -> NamesT m Term
bA NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> (NamesT m Term
i NamesT m Term -> NamesT m Term -> NamesT m Term
`imax` NamesT m Term
r))
                                      NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT m Term
r
                                      NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT m Term
u
  (NamesT m Term
 -> NamesT m Term
 -> NamesT m Term
 -> NamesT m Term
 -> NamesT m Term
 -> NamesT m Term)
-> NamesT
     m
     (NamesT m Term
      -> NamesT m Term
      -> NamesT m Term
      -> NamesT m Term
      -> NamesT m Term
      -> NamesT m Term)
forall (m :: * -> *) a. Monad m => a -> m a
return ((NamesT m Term
  -> NamesT m Term
  -> NamesT m Term
  -> NamesT m Term
  -> NamesT m Term
  -> NamesT m Term)
 -> NamesT
      m
      (NamesT m Term
       -> NamesT m Term
       -> NamesT m Term
       -> NamesT m Term
       -> NamesT m Term
       -> NamesT m Term))
-> (NamesT m Term
    -> NamesT m Term
    -> NamesT m Term
    -> NamesT m Term
    -> NamesT m Term
    -> NamesT m Term)
-> NamesT
     m
     (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
la NamesT m Term
bA NamesT m Term
phi NamesT m Term
u NamesT m Term
u0 ->
    Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
tHComp NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> (NamesT m Term
la NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
io)
                NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> (NamesT m Term
bA NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
io)
                NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> NamesT m Term -> NamesT m Term -> NamesT m Term
imax NamesT m Term
phi (NamesT m Term -> NamesT m Term
ineg NamesT m Term
phi)
                NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
lam String
"i" (\ NamesT m Term
i ->
                      Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
tPOr NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> (NamesT m Term
la NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT m Term
i)
                                NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT m Term
phi
                                NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT m Term -> NamesT m Term
ineg NamesT m Term
phi
                                NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
ilam String
"o" (\ NamesT m Term
a -> NamesT m Term
bA NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT m Term
i)
                                NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> 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
o -> NamesT m Term
-> NamesT m Term -> NamesT m Term -> NamesT m Term -> NamesT m Term
forward NamesT m Term
la NamesT m Term
bA NamesT m Term
i (NamesT m Term
u NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT m Term
i NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<..> NamesT m Term
o))
                                NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> 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
o -> NamesT m Term
-> NamesT m Term -> NamesT m Term -> NamesT m Term -> NamesT m Term
forward NamesT m Term
la NamesT m Term
bA (Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
iz) NamesT m Term
u0))
                NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT m Term
-> NamesT m Term -> NamesT m Term -> NamesT m Term -> NamesT m Term
forward NamesT m Term
la NamesT m Term
bA (Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
iz) NamesT m Term
u0


unglueTranspGlue :: PureTCM m =>
                  Arg Term
                  -> Arg Term
                  -> FamilyOrNot
                       (Arg Term, Arg Term, Arg Term, Arg Term, Arg Term, Arg Term)
                  -> m Term
-- ...    |- psi, u0
-- ..., i |- la, lb, bA, phi, bT, e
unglueTranspGlue :: Arg Term
-> Arg Term
-> FamilyOrNot
     (Arg Term, Arg Term, Arg Term, Arg Term, Arg Term, Arg Term)
-> m Term
unglueTranspGlue Arg Term
psi Arg Term
u0 (IsFam (Arg Term
la, Arg Term
lb, Arg Term
bA, Arg Term
phi, Arg Term
bT, Arg Term
e)) = do
      let
        localUse :: String
localUse = String
builtinTrans String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" for " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
builtinGlue
        getTermLocal :: String -> m Term
getTermLocal = String -> String -> m Term
forall (m :: * -> *). HasBuiltins m => String -> String -> m Term
getTerm String
localUse
      Term
tPOr <- String -> m Term
getTermLocal String
"primPOr"
      Term
tIMax <- String -> m Term
getTermLocal String
builtinIMax
      Term
tIMin <- String -> m Term
getTermLocal String
builtinIMin
      Term
tINeg <- String -> m Term
getTermLocal String
builtinINeg
      Term
tHComp <- String -> m Term
getTermLocal String
builtinHComp
      Term
tTrans <- String -> m Term
getTermLocal String
builtinTrans
      Term
tForall  <- String -> m Term
getTermLocal String
builtinFaceForall
      Term
tEFun  <- String -> m Term
getTermLocal String
builtinEquivFun
      Term
tEProof <- String -> m Term
getTermLocal String
builtinEquivProof
      Term
tglue   <- String -> m Term
getTermLocal String
builtin_glue
      Term
tunglue <- String -> m Term
getTermLocal String
builtin_unglue
      Term
io      <- String -> m Term
getTermLocal String
builtinIOne
      Term
iz      <- String -> m Term
getTermLocal String
builtinIZero
      Term
tLMax   <- String -> m Term
getTermLocal String
builtinLevelMax
      Term
tPath   <- String -> m Term
getTermLocal String
builtinPath
      Term
tTransp <- String -> m Term
getTermLocal String
builtinTranspProof
      Term
tItIsOne <- String -> m Term
getTermLocal String
builtinItIsOne
      SigmaKit
kit <- SigmaKit -> Maybe SigmaKit -> SigmaKit
forall a. a -> Maybe a -> a
fromMaybe SigmaKit
forall a. HasCallStack => a
__IMPOSSIBLE__ (Maybe SigmaKit -> SigmaKit) -> m (Maybe SigmaKit) -> m SigmaKit
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (Maybe SigmaKit)
forall (m :: * -> *).
(HasBuiltins m, HasConstInfo m) =>
m (Maybe SigmaKit)
getSigmaKit
      Names -> NamesT m Term -> m Term
forall (m :: * -> *) a. Names -> NamesT m a -> m a
runNamesT [] (NamesT m Term -> m Term) -> NamesT m Term -> m Term
forall a b. (a -> b) -> a -> b
$ do
        let ineg :: NamesT m Term -> NamesT m Term
ineg NamesT m Term
j = Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
tINeg NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT m Term
j
            imax :: NamesT m Term -> NamesT m Term -> NamesT m Term
imax NamesT m Term
i NamesT m Term
j = Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
tIMax 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
            imin :: NamesT m Term -> NamesT m Term -> NamesT m Term
imin NamesT m Term
i NamesT m Term
j = Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
tIMin 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

        NamesT m Term
-> NamesT m Term
-> NamesT m Term
-> NamesT m Term
-> NamesT m Term
-> NamesT m Term
gcomp <- String
-> NamesT
     m
     (NamesT m Term
      -> NamesT m Term
      -> NamesT m Term
      -> NamesT m Term
      -> NamesT m Term
      -> NamesT m 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)
mkGComp String
localUse

        let transpFill :: NamesT m Term
-> NamesT m Term
-> NamesT m Term
-> NamesT m Term
-> NamesT m Term
-> NamesT m Term
transpFill NamesT m Term
la NamesT m Term
bA NamesT m Term
phi NamesT m Term
u0 NamesT m Term
i =
              Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
tTrans NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
ilam String
"j" (\ NamesT m Term
j -> NamesT m Term
la NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT m Term -> NamesT m Term -> NamesT m Term
imin NamesT m Term
i NamesT m Term
j)
                          NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
ilam String
"j" (\ NamesT m Term
j -> NamesT m Term
bA NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT m Term -> NamesT m Term -> NamesT m Term
imin NamesT m Term
i NamesT m Term
j)
                          NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> (NamesT m Term -> NamesT m Term -> NamesT m Term
imax NamesT m Term
phi (NamesT m Term -> NamesT m Term
ineg 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
u0
        [NamesT m Term
psi,NamesT m Term
u0] <- (Arg Term -> NamesT m (NamesT m Term))
-> [Arg Term] -> NamesT m [NamesT m Term]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Term -> NamesT m (NamesT m Term)
forall (m :: * -> *) a.
(MonadFail m, Subst a) =>
a -> NamesT m (NamesT m a)
open (Term -> NamesT m (NamesT m Term))
-> (Arg Term -> Term) -> Arg Term -> NamesT m (NamesT m Term)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Arg Term -> Term
forall e. Arg e -> e
unArg) [Arg Term
psi,Arg Term
u0]

        -- glue1 t a = glue la[i1/i] lb[i1/i] bA[i1/i] phi[i1/i] bT[i1/i] e[i1/i] t a
        NamesT m Term -> NamesT m Term -> NamesT m Term
glue1 <- do
          NamesT m Term
g <- Term -> NamesT m (NamesT m Term)
forall (m :: * -> *) a.
(MonadFail m, Subst a) =>
a -> NamesT m (NamesT m a)
open (Term -> NamesT m (NamesT m Term))
-> Term -> NamesT m (NamesT m Term)
forall a b. (a -> b) -> a -> b
$ (Term
tglue Term -> [Arg Term] -> Term
forall t. Apply t => t -> [Arg Term] -> t
`apply`) ([Arg Term] -> Term)
-> ([Arg Term] -> [Arg Term]) -> [Arg Term] -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Arg Term -> Arg Term) -> [Arg Term] -> [Arg Term]
forall a b. (a -> b) -> [a] -> [b]
map ((Hiding -> Arg Term -> Arg Term
forall a. LensHiding a => Hiding -> a -> a
setHiding Hiding
Hidden) (Arg Term -> Arg Term)
-> (Arg Term -> Arg Term) -> Arg Term -> Arg Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Arity -> SubstArg (Arg Term) -> Arg Term -> Arg Term
forall a. Subst a => Arity -> SubstArg a -> a -> a
subst Arity
0 Term
SubstArg (Arg Term)
io)) ([Arg Term] -> Term) -> [Arg Term] -> Term
forall a b. (a -> b) -> a -> b
$ [Arg Term
la, Arg Term
lb, Arg Term
bA, Arg Term
phi, Arg Term
bT, Arg Term
e]
          (NamesT m Term -> NamesT m Term -> NamesT m Term)
-> NamesT m (NamesT m Term -> NamesT m Term -> NamesT m Term)
forall (m :: * -> *) a. Monad m => a -> m a
return ((NamesT m Term -> NamesT m Term -> NamesT m Term)
 -> NamesT m (NamesT m Term -> NamesT m Term -> NamesT m Term))
-> (NamesT m Term -> NamesT m Term -> NamesT m Term)
-> NamesT m (NamesT m Term -> NamesT m Term -> NamesT m Term)
forall a b. (a -> b) -> a -> b
$ \ NamesT m Term
t NamesT m Term
a -> NamesT m Term
g NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT m Term
t NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT m Term
a

        [NamesT m Term
la, NamesT m Term
lb, NamesT m Term
bA, NamesT m Term
phi, NamesT m Term
bT, NamesT m Term
e] <- (Arg Term -> NamesT m (NamesT m Term))
-> [Arg Term] -> NamesT m [NamesT m Term]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\ Arg Term
a -> Term -> NamesT m (NamesT m Term)
forall (m :: * -> *) a.
(MonadFail m, Subst a) =>
a -> NamesT m (NamesT m a)
open (Term -> NamesT m (NamesT m Term))
-> (NamesT Fail Term -> Term)
-> NamesT Fail Term
-> NamesT m (NamesT m Term)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Names -> NamesT Fail Term -> Term
forall a. Names -> NamesT Fail a -> a
runNames [] (NamesT Fail Term -> NamesT m (NamesT m Term))
-> NamesT Fail Term -> NamesT m (NamesT m Term)
forall a b. (a -> b) -> a -> b
$ String
-> (NamesT Fail Term -> NamesT Fail Term) -> NamesT Fail Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
lam String
"i" (NamesT Fail Term -> NamesT Fail Term -> NamesT Fail Term
forall a b. a -> b -> a
const (Term -> NamesT Fail Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term -> NamesT Fail Term) -> Term -> NamesT Fail Term
forall a b. (a -> b) -> a -> b
$ Arg Term -> Term
forall e. Arg e -> e
unArg Arg Term
a))) [Arg Term
la, Arg Term
lb, Arg Term
bA, Arg Term
phi, Arg Term
bT, Arg Term
e]

        -- Andreas, 2022-03-24, fixing #5838
        -- Following the updated note
        --
        --   Simon Huber, A Cubical Type Theory for Higher Inductive Types
        --   https://simhu.github.io/misc/hcomp.pdf (February 2022)
        --
        -- See: https://github.com/agda/agda/issues/5755#issuecomment-1043797776

        -- unglue_u0 i = unglue la[i/i] lb[i/i] bA[i/i] phi[i/i] bT[i/i] e[i/i] u0
        let unglue_u0 :: NamesT m Term -> NamesT m Term
unglue_u0 NamesT m Term
i =
              (NamesT m Term -> NamesT m Term -> NamesT m Term)
-> NamesT m Term -> [NamesT m Term] -> NamesT m Term
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
(<#>) (Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
tunglue) ((NamesT m Term -> NamesT m Term)
-> [NamesT m Term] -> [NamesT m Term]
forall a b. (a -> b) -> [a] -> [b]
map (NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT m Term
i) [NamesT m Term
la, NamesT m Term
lb, NamesT m Term
bA, NamesT m Term
phi, NamesT m Term
bT, NamesT m Term
e]) NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT m Term
u0

        Term -> IntervalView
view <- NamesT m (Term -> IntervalView)
forall (m :: * -> *). HasBuiltins m => m (Term -> IntervalView)
intervalView'

        let
          tf :: NamesT m Term -> NamesT m Term -> NamesT m Term
tf NamesT m Term
i NamesT m Term
o = NamesT m Term
-> NamesT m Term
-> NamesT m Term
-> NamesT m Term
-> NamesT m Term
-> NamesT m Term
transpFill NamesT m Term
lb (String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
lam String
"i" ((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
i -> NamesT m Term
bT NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT m Term
i NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<..> NamesT m Term
o) NamesT m Term
psi NamesT m Term
u0 NamesT m Term
i
          t1 :: NamesT m Term -> NamesT m Term
t1 NamesT m Term
o = NamesT m Term -> NamesT m Term -> NamesT m Term
tf (Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
io) NamesT m Term
o

          -- compute "forall. phi"
          forallphi :: NamesT m Term
forallphi = Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
tForall NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT m Term
phi

          -- a1 with gcomp
          a1 :: NamesT m Term
a1 = NamesT m Term
-> NamesT m Term
-> NamesT m Term
-> NamesT m Term
-> NamesT m Term
-> NamesT m Term
gcomp NamesT m Term
la NamesT m Term
bA
                 (NamesT m Term -> NamesT m Term -> NamesT m Term
imax NamesT m Term
psi NamesT m Term
forallphi)
                 (String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
lam String
"i" ((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
i -> Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
tPOr NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> (NamesT m Term
la NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT m Term
i)
                                             NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT m Term
psi
                                             NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT m Term
forallphi
                                             NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
ilam String
"o" (\ NamesT m Term
a -> NamesT m Term
bA NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT m Term
i)
                                             NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> 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
unglue_u0 NamesT m Term
i)
                                             NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
ilam String
"o" (\ NamesT m Term
o -> Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
tEFun NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> (NamesT m Term
lb 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
la NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT m Term
i)
                                                                               NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> (NamesT m Term
bT NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT m Term
i NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<..> NamesT m Term
o)
                                                                               NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> (NamesT m Term
bA NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT m Term
i)
                                                                               NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> (NamesT m Term
e NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT m Term
i NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<..> NamesT m Term
o)
                                                                               NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> (NamesT m Term -> NamesT m Term -> NamesT m Term
tf NamesT m Term
i NamesT m Term
o)))
                 (NamesT m Term -> NamesT m Term
unglue_u0 (Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
iz))

          max :: NamesT m Term -> NamesT m Term -> NamesT m Term
max NamesT m Term
l NamesT m Term
l' = Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
tLMax NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT m Term
l NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT m Term
l'
          sigCon :: NamesT m Term -> NamesT m Term -> NamesT m Term
sigCon NamesT m Term
x NamesT m Term
y = Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ConHead -> ConInfo -> [Elim] -> Term
Con (SigmaKit -> ConHead
sigmaCon SigmaKit
kit) ConInfo
ConOSystem []) NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT m Term
x NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT m Term
y
          w :: NamesT m Term -> NamesT m Term -> NamesT m Term
w NamesT m Term
i NamesT m Term
o = Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
tEFun NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> (NamesT m Term
lb 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
la NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT m Term
i)
                             NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> (NamesT m Term
bT NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT m Term
i NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<..> NamesT m Term
o)
                             NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> (NamesT m Term
bA NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT m Term
i)
                             NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> (NamesT m Term
e NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT m Term
i NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<..> NamesT m Term
o)
          fiber :: NamesT m Term
-> NamesT m Term
-> NamesT m Term
-> NamesT m Term
-> NamesT m Term
-> NamesT m Term
-> NamesT m Term
fiber NamesT m Term
la NamesT m Term
lb NamesT m Term
bA NamesT m Term
bB NamesT m Term
f NamesT m Term
b =
            (Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure (QName -> [Elim] -> Term
Def (SigmaKit -> QName
sigmaName SigmaKit
kit) []) NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> NamesT m Term
la
                                           NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> NamesT m Term
lb
                                           NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT m Term
bA
                                           NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
lam String
"a" (\ NamesT m Term
a -> Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
tPath NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> NamesT m Term
lb NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> NamesT m Term
bB NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> (NamesT m Term
f NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT m Term
a) NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT m Term
b))

          -- We don't have to do anything special for "~ forall. phi"
          -- here (to implement "ghcomp") as it is taken care off by
          -- tEProof in t1'alpha below
          pe :: NamesT m Term -> NamesT m Term
pe NamesT m Term
o = -- o : [ φ 1 ]
            Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
tPOr NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> NamesT m Term -> NamesT m Term -> NamesT m Term
max (NamesT m Term
la NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
io) (NamesT m Term
lb NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
io)
                      NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT m Term
psi
                      NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT m Term
forallphi
                      NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
forall (m :: * -> *).
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
-> NamesT m Term
-> NamesT m Term
fiber (NamesT m Term
lb NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
io) (NamesT m Term
la NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
io)
                                   (NamesT m Term
bT NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> (Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
io) NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<..> NamesT m Term
o) (NamesT m Term
bA NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
io)
                                   (NamesT m Term -> NamesT m Term -> NamesT m Term
w (Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
io) NamesT m Term
o) NamesT m Term
a1)
                      NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
ilam String
"o" (\ NamesT m Term
o -> NamesT m Term -> NamesT m Term -> NamesT m Term
sigCon NamesT m Term
u0 (String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
lam String
"_" ((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
a1))
                      NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
ilam String
"o" (\ NamesT m Term
o -> NamesT m Term -> NamesT m Term -> NamesT m Term
sigCon (NamesT m Term -> NamesT m Term
t1 NamesT m Term
o) (String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
lam String
"_" ((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
a1))

          -- "ghcomp" is implemented in the proof of tEProof
          -- (see src/data/lib/prim/Agda/Builtin/Cubical/Glue.agda)
          t1'alpha :: NamesT m Term -> NamesT m Term
t1'alpha NamesT m Term
o = -- o : [ φ 1 ]
             Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
tEProof NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> (NamesT m Term
lb NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
io)
                          NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> (NamesT m Term
la NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
io)
                          NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> (NamesT m Term
bT NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
io NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<..> NamesT m Term
o)
                          NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> (NamesT m Term
bA NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
io)
                          NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> (NamesT m Term
e NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
io NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<..> NamesT m Term
o)
                          NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT m Term
a1
                          NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> (NamesT m Term -> NamesT m Term -> NamesT m Term
imax NamesT m Term
psi NamesT m Term
forallphi)
                          NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT m Term -> NamesT m Term
pe NamesT m Term
o

          -- TODO: optimize?
          t1' :: NamesT m Term -> NamesT m Term
t1' NamesT m Term
o = NamesT m Term -> NamesT m Term
t1'alpha NamesT m Term
o NamesT m Term -> (Term -> Term) -> NamesT m Term
forall (m :: * -> *) a b. Functor m => m a -> (a -> b) -> m b
<&> (Term -> [Elim] -> Term
forall t. Apply t => t -> [Elim] -> t
`applyE` [ProjOrigin -> QName -> Elim
forall a. ProjOrigin -> QName -> Elim' a
Proj ProjOrigin
ProjSystem (SigmaKit -> QName
sigmaFst SigmaKit
kit)])
          alpha :: NamesT m Term -> NamesT m Term
alpha NamesT m Term
o = NamesT m Term -> NamesT m Term
t1'alpha NamesT m Term
o NamesT m Term -> (Term -> Term) -> NamesT m Term
forall (m :: * -> *) a b. Functor m => m a -> (a -> b) -> m b
<&> (Term -> [Elim] -> Term
forall t. Apply t => t -> [Elim] -> t
`applyE` [ProjOrigin -> QName -> Elim
forall a. ProjOrigin -> QName -> Elim' a
Proj ProjOrigin
ProjSystem (SigmaKit -> QName
sigmaSnd SigmaKit
kit)])
          a1' :: NamesT m Term
a1' = Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
tHComp
                  NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> (NamesT m Term
la NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
io)
                  NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> (NamesT m Term
bA NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
io)
                  NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> (NamesT m Term -> NamesT m Term -> NamesT m Term
imax (NamesT m Term
phi NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
io) NamesT m Term
psi)
                  NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
lam String
"j" (\ NamesT m Term
j ->
                         Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
tPOr NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> (NamesT m Term
la NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
io) NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> (NamesT m Term
phi NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
io) NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT m Term
psi NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
ilam String
"o" (\ NamesT m Term
_ -> NamesT m Term
bA NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
io)
                                   NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> 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
o -> NamesT m Term -> NamesT m Term
alpha NamesT m Term
o NamesT m Term
-> (NamesT m Term, NamesT m Term, NamesT m Term) -> NamesT m Term
forall (m :: * -> *).
Applicative m =>
m Term -> (m Term, m Term, m Term) -> m Term
<@@> (NamesT m Term -> NamesT m Term -> NamesT m Term
w (Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
io) NamesT m Term
o NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT m Term -> NamesT m Term
t1' NamesT m Term
o,NamesT m Term
a1,NamesT m Term
j))
                                   NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
ilam String
"o" (\ NamesT m Term
_ -> NamesT m Term
a1))
                  NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT m Term
a1
        -- glue1 (ilam "o" t1') a1'
        NamesT m Term
a1'
unglueTranspGlue Arg Term
_ Arg Term
_ FamilyOrNot
  (Arg Term, Arg Term, Arg Term, Arg Term, Arg Term, Arg Term)
_ = m Term
forall a. HasCallStack => a
__IMPOSSIBLE__

data TermPosition = Head | Eliminated deriving (TermPosition -> TermPosition -> Bool
(TermPosition -> TermPosition -> Bool)
-> (TermPosition -> TermPosition -> Bool) -> Eq TermPosition
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TermPosition -> TermPosition -> Bool
$c/= :: TermPosition -> TermPosition -> Bool
== :: TermPosition -> TermPosition -> Bool
$c== :: TermPosition -> TermPosition -> Bool
Eq,Arity -> TermPosition -> String -> String
[TermPosition] -> String -> String
TermPosition -> String
(Arity -> TermPosition -> String -> String)
-> (TermPosition -> String)
-> ([TermPosition] -> String -> String)
-> Show TermPosition
forall a.
(Arity -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [TermPosition] -> String -> String
$cshowList :: [TermPosition] -> String -> String
show :: TermPosition -> String
$cshow :: TermPosition -> String
showsPrec :: Arity -> TermPosition -> String -> String
$cshowsPrec :: Arity -> TermPosition -> String -> String
Show)

headStop :: PureTCM m => TermPosition -> m Term -> m Bool
headStop :: TermPosition -> m Term -> m Bool
headStop TermPosition
tpos m Term
phi
  | TermPosition
Head <- TermPosition
tpos = do
      IntervalView
phi <- Term -> m IntervalView
forall (m :: * -> *). HasBuiltins m => Term -> m IntervalView
intervalView (Term -> m IntervalView) -> m Term -> m IntervalView
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Term -> m Term
forall a (m :: * -> *). (Reduce a, MonadReduce m) => a -> m a
reduce (Term -> m Term) -> m Term -> m Term
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m Term
phi)
      Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> m Bool) -> Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ IntervalView -> Bool
isIOne IntervalView
phi
  | Bool
otherwise = Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False

compGlue :: PureTCM m =>
                  TranspOrHComp
                  -> Arg Term
                  -> Maybe (Arg Term)
                  -> Arg Term
                  -> FamilyOrNot
                       (Arg Term, Arg Term, Arg Term, Arg Term, Arg Term, Arg Term)
                  -> TermPosition
                  -> m (Maybe Term)
compGlue :: TranspOrHComp
-> Arg Term
-> Maybe (Arg Term)
-> Arg Term
-> FamilyOrNot
     (Arg Term, Arg Term, Arg Term, Arg Term, Arg Term, Arg Term)
-> TermPosition
-> m (Maybe Term)
compGlue TranspOrHComp
DoHComp Arg Term
psi (Just Arg Term
u) Arg Term
u0 (IsNot (Arg Term
la, Arg Term
lb, Arg Term
bA, Arg Term
phi, Arg Term
bT, Arg Term
e)) TermPosition
tpos = do
      let getTermLocal :: String -> m Term
getTermLocal = String -> String -> m Term
forall (m :: * -> *). HasBuiltins m => String -> String -> m Term
getTerm (String -> String -> m Term) -> String -> String -> m Term
forall a b. (a -> b) -> a -> b
$ (String
builtinHComp String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" for " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
builtinGlue)
      Term
tPOr <- String -> m Term
getTermLocal String
"primPOr"
      Term
tIMax <- String -> m Term
getTermLocal String
builtinIMax
      Term
tIMin <- String -> m Term
getTermLocal String
builtinIMin
      Term
tINeg <- String -> m Term
getTermLocal String
builtinINeg
      Term
tHComp <- String -> m Term
getTermLocal String
builtinHComp
      Term
tEFun  <- String -> m Term
getTermLocal String
builtinEquivFun
      Term
tglue   <- String -> m Term
getTermLocal String
builtin_glue
      Term
tunglue <- String -> m Term
getTermLocal String
builtin_unglue
      Term
io      <- String -> m Term
getTermLocal String
builtinIOne
      Term
tItIsOne <- String -> m Term
getTermLocal String
builtinItIsOne
      Term -> IntervalView
view <- m (Term -> IntervalView)
forall (m :: * -> *). HasBuiltins m => m (Term -> IntervalView)
intervalView'
      Names -> NamesT m (Maybe Term) -> m (Maybe Term)
forall (m :: * -> *) a. Names -> NamesT m a -> m a
runNamesT [] (NamesT m (Maybe Term) -> m (Maybe Term))
-> NamesT m (Maybe Term) -> m (Maybe Term)
forall a b. (a -> b) -> a -> b
$ do
        [NamesT m Term
psi, NamesT m Term
u, NamesT m Term
u0] <- (Arg Term -> NamesT m (NamesT m Term))
-> [Arg Term] -> NamesT m [NamesT m Term]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Term -> NamesT m (NamesT m Term)
forall (m :: * -> *) a.
(MonadFail m, Subst a) =>
a -> NamesT m (NamesT m a)
open (Term -> NamesT m (NamesT m Term))
-> (Arg Term -> Term) -> Arg Term -> NamesT m (NamesT m Term)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Arg Term -> Term
forall e. Arg e -> e
unArg) [Arg Term
psi, Arg Term
u, Arg Term
u0]
        [NamesT m Term
la, NamesT m Term
lb, NamesT m Term
bA, NamesT m Term
phi, NamesT m Term
bT, NamesT m Term
e] <- (Arg Term -> NamesT m (NamesT m Term))
-> [Arg Term] -> NamesT m [NamesT m Term]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Term -> NamesT m (NamesT m Term)
forall (m :: * -> *) a.
(MonadFail m, Subst a) =>
a -> NamesT m (NamesT m a)
open (Term -> NamesT m (NamesT m Term))
-> (Arg Term -> Term) -> Arg Term -> NamesT m (NamesT m Term)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Arg Term -> Term
forall e. Arg e -> e
unArg) [Arg Term
la, Arg Term
lb, Arg Term
bA, Arg Term
phi, Arg Term
bT, Arg Term
e]
        NamesT m Bool
-> NamesT m (Maybe Term)
-> NamesT m (Maybe Term)
-> NamesT m (Maybe Term)
forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifM (TermPosition -> NamesT m Term -> NamesT m Bool
forall (m :: * -> *). PureTCM m => TermPosition -> m Term -> m Bool
headStop TermPosition
tpos NamesT m Term
phi) (Maybe Term -> NamesT m (Maybe Term)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Term
forall a. Maybe a
Nothing) (NamesT m (Maybe Term) -> NamesT m (Maybe Term))
-> NamesT m (Maybe Term) -> NamesT m (Maybe Term)
forall a b. (a -> b) -> a -> b
$ Term -> Maybe Term
forall a. a -> Maybe a
Just (Term -> Maybe Term) -> NamesT m Term -> NamesT m (Maybe Term)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do

        let
          hfill :: NamesT m Term
-> NamesT m Term
-> NamesT m Term
-> NamesT m Term
-> NamesT m Term
-> NamesT m Term
-> NamesT m Term
hfill NamesT m Term
la NamesT m Term
bA NamesT m Term
phi NamesT m Term
u NamesT m Term
u0 NamesT m Term
i = Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
tHComp NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> NamesT m Term
la
                                               NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> NamesT m Term
bA
                                               NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> (Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
tIMax NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT m Term
phi NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> (Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
tINeg 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
<@> String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
lam String
"j" (\ NamesT m Term
j -> Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
tPOr NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> NamesT m Term
la NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT m Term
phi NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> (Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
tINeg 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
<@> 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
a -> NamesT m Term
bA)
                                                     NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
ilam String
"o" (\ NamesT m Term
o -> NamesT m Term
u NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> (Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
tIMin 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) NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<..> NamesT m Term
o)
                                                     NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> 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
u0))
                                               NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT m Term
u0
          tf :: NamesT m Term -> NamesT m Term -> NamesT m Term
tf NamesT m Term
i NamesT m Term
o = NamesT m Term
-> NamesT m Term
-> NamesT m Term
-> NamesT m Term
-> NamesT m Term
-> NamesT m Term
-> NamesT m Term
hfill NamesT m Term
lb (NamesT m Term
bT NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<..> NamesT m Term
o) NamesT m Term
psi NamesT m Term
u NamesT m Term
u0 NamesT m Term
i
          unglue :: NamesT m Term -> NamesT m Term
unglue NamesT m Term
g = Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
tunglue NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> NamesT m Term
la NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> NamesT m Term
lb NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> NamesT m Term
bA NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> NamesT m Term
phi NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> NamesT m Term
bT NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> NamesT m Term
e NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT m Term
g
          a1 :: NamesT m Term
a1 = Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
tHComp NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> NamesT m Term
la NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> NamesT m Term
bA NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> (Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
tIMax NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT m Term
psi NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT m Term
phi)
                           NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
lam String
"i" (\ NamesT m Term
i -> Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
tPOr NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> NamesT m Term
la NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT m Term
psi NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT m Term
phi NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
ilam String
"_" (\ NamesT m Term
_ -> NamesT m Term
bA)
                                 NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> 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
o -> NamesT m Term -> NamesT m Term
unglue (NamesT m Term
u NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT m Term
i NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<..> NamesT m Term
o))
                                 NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> 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
o -> Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
tEFun NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> NamesT m Term
lb NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> NamesT m Term
la NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> (NamesT m Term
bT NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<..> NamesT m Term
o) NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> NamesT m Term
bA NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> (NamesT m Term
e NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<..> NamesT m Term
o) NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT m Term -> NamesT m Term -> NamesT m Term
tf NamesT m Term
i NamesT m Term
o))
                           NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> (NamesT m Term -> NamesT m Term
unglue NamesT m Term
u0)
          t1 :: NamesT m Term -> NamesT m Term
t1 = NamesT m Term -> NamesT m Term -> NamesT m Term
tf (Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
io)
        -- pure tglue <#> la <#> lb <#> bA <#> phi <#> bT <#> e <@> (ilam "o" $ \ o -> t1 o) <@> a1
        case TermPosition
tpos of
          TermPosition
Head -> NamesT m Term -> NamesT m Term
t1 (Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
tItIsOne)
          TermPosition
Eliminated -> NamesT m Term
a1

-- ...    |- psi, u0
-- ..., i |- la, lb, bA, phi, bT, e
compGlue TranspOrHComp
DoTransp Arg Term
psi Maybe (Arg Term)
Nothing Arg Term
u0 (IsFam (Arg Term
la, Arg Term
lb, Arg Term
bA, Arg Term
phi, Arg Term
bT, Arg Term
e)) TermPosition
tpos = do
      let
        localUse :: String
localUse = String
builtinTrans String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" for " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
builtinGlue
        getTermLocal :: String -> m Term
getTermLocal = String -> String -> m Term
forall (m :: * -> *). HasBuiltins m => String -> String -> m Term
getTerm String
localUse
      Term
tPOr <- String -> m Term
getTermLocal String
"primPOr"
      Term
tIMax <- String -> m Term
getTermLocal String
builtinIMax
      Term
tIMin <- String -> m Term
getTermLocal String
builtinIMin
      Term
tINeg <- String -> m Term
getTermLocal String
builtinINeg
      Term
tHComp <- String -> m Term
getTermLocal String
builtinHComp
      Term
tTrans <- String -> m Term
getTermLocal String
builtinTrans
      Term
tForall  <- String -> m Term
getTermLocal String
builtinFaceForall
      Term
tEFun  <- String -> m Term
getTermLocal String
builtinEquivFun
      Term
tEProof <- String -> m Term
getTermLocal String
builtinEquivProof
      Term
tglue   <- String -> m Term
getTermLocal String
builtin_glue
      Term
tunglue <- String -> m Term
getTermLocal String
builtin_unglue
      Term
io      <- String -> m Term
getTermLocal String
builtinIOne
      Term
iz      <- String -> m Term
getTermLocal String
builtinIZero
      Term
tLMax   <- String -> m Term
getTermLocal String
builtinLevelMax
      Term
tPath   <- String -> m Term
getTermLocal String
builtinPath
      Term
tTransp <- String -> m Term
getTermLocal String
builtinTranspProof
      Term
tItIsOne <- String -> m Term
getTermLocal String
builtinItIsOne
      SigmaKit
kit <- SigmaKit -> Maybe SigmaKit -> SigmaKit
forall a. a -> Maybe a -> a
fromMaybe SigmaKit
forall a. HasCallStack => a
__IMPOSSIBLE__ (Maybe SigmaKit -> SigmaKit) -> m (Maybe SigmaKit) -> m SigmaKit
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (Maybe SigmaKit)
forall (m :: * -> *).
(HasBuiltins m, HasConstInfo m) =>
m (Maybe SigmaKit)
getSigmaKit
      Names -> NamesT m (Maybe Term) -> m (Maybe Term)
forall (m :: * -> *) a. Names -> NamesT m a -> m a
runNamesT [] (NamesT m (Maybe Term) -> m (Maybe Term))
-> NamesT m (Maybe Term) -> m (Maybe Term)
forall a b. (a -> b) -> a -> b
$ do
        let ineg :: NamesT m Term -> NamesT m Term
ineg NamesT m Term
j = Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
tINeg NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT m Term
j
            imax :: NamesT m Term -> NamesT m Term -> NamesT m Term
imax NamesT m Term
i NamesT m Term
j = Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
tIMax 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
            imin :: NamesT m Term -> NamesT m Term -> NamesT m Term
imin NamesT m Term
i NamesT m Term
j = Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
tIMin 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

        NamesT m Term
-> NamesT m Term
-> NamesT m Term
-> NamesT m Term
-> NamesT m Term
-> NamesT m Term
gcomp <- String
-> NamesT
     m
     (NamesT m Term
      -> NamesT m Term
      -> NamesT m Term
      -> NamesT m Term
      -> NamesT m Term
      -> NamesT m 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)
mkGComp String
localUse

        let transpFill :: NamesT m Term
-> NamesT m Term
-> NamesT m Term
-> NamesT m Term
-> NamesT m Term
-> NamesT m Term
transpFill NamesT m Term
la NamesT m Term
bA NamesT m Term
phi NamesT m Term
u0 NamesT m Term
i =
              Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
tTrans NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
ilam String
"j" (\ NamesT m Term
j -> NamesT m Term
la NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT m Term -> NamesT m Term -> NamesT m Term
imin NamesT m Term
i NamesT m Term
j)
                          NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
ilam String
"j" (\ NamesT m Term
j -> NamesT m Term
bA NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT m Term -> NamesT m Term -> NamesT m Term
imin NamesT m Term
i NamesT m Term
j)
                          NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> (NamesT m Term -> NamesT m Term -> NamesT m Term
imax NamesT m Term
phi (NamesT m Term -> NamesT m Term
ineg 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
u0
        [NamesT m Term
psi,NamesT m Term
u0] <- (Arg Term -> NamesT m (NamesT m Term))
-> [Arg Term] -> NamesT m [NamesT m Term]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Term -> NamesT m (NamesT m Term)
forall (m :: * -> *) a.
(MonadFail m, Subst a) =>
a -> NamesT m (NamesT m a)
open (Term -> NamesT m (NamesT m Term))
-> (Arg Term -> Term) -> Arg Term -> NamesT m (NamesT m Term)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Arg Term -> Term
forall e. Arg e -> e
unArg) [Arg Term
psi,Arg Term
u0]

        -- glue1 t a = glue la[i1/i] lb[i1/i] bA[i1/i] phi[i1/i] bT[i1/i] e[i1/i] t a
        NamesT m Term -> NamesT m Term -> NamesT m Term
glue1 <- do
          NamesT m Term
g <- Term -> NamesT m (NamesT m Term)
forall (m :: * -> *) a.
(MonadFail m, Subst a) =>
a -> NamesT m (NamesT m a)
open (Term -> NamesT m (NamesT m Term))
-> Term -> NamesT m (NamesT m Term)
forall a b. (a -> b) -> a -> b
$ (Term
tglue Term -> [Arg Term] -> Term
forall t. Apply t => t -> [Arg Term] -> t
`apply`) ([Arg Term] -> Term)
-> ([Arg Term] -> [Arg Term]) -> [Arg Term] -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Arg Term -> Arg Term) -> [Arg Term] -> [Arg Term]
forall a b. (a -> b) -> [a] -> [b]
map ((Hiding -> Arg Term -> Arg Term
forall a. LensHiding a => Hiding -> a -> a
setHiding Hiding
Hidden) (Arg Term -> Arg Term)
-> (Arg Term -> Arg Term) -> Arg Term -> Arg Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Arity -> SubstArg (Arg Term) -> Arg Term -> Arg Term
forall a. Subst a => Arity -> SubstArg a -> a -> a
subst Arity
0 Term
SubstArg (Arg Term)
io)) ([Arg Term] -> Term) -> [Arg Term] -> Term
forall a b. (a -> b) -> a -> b
$ [Arg Term
la, Arg Term
lb, Arg Term
bA, Arg Term
phi, Arg Term
bT, Arg Term
e]
          (NamesT m Term -> NamesT m Term -> NamesT m Term)
-> NamesT m (NamesT m Term -> NamesT m Term -> NamesT m Term)
forall (m :: * -> *) a. Monad m => a -> m a
return ((NamesT m Term -> NamesT m Term -> NamesT m Term)
 -> NamesT m (NamesT m Term -> NamesT m Term -> NamesT m Term))
-> (NamesT m Term -> NamesT m Term -> NamesT m Term)
-> NamesT m (NamesT m Term -> NamesT m Term -> NamesT m Term)
forall a b. (a -> b) -> a -> b
$ \ NamesT m Term
t NamesT m Term
a -> NamesT m Term
g NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT m Term
t NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT m Term
a

        [NamesT m Term
la, NamesT m Term
lb, NamesT m Term
bA, NamesT m Term
phi, NamesT m Term
bT, NamesT m Term
e] <- (Arg Term -> NamesT m (NamesT m Term))
-> [Arg Term] -> NamesT m [NamesT m Term]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\ Arg Term
a -> Term -> NamesT m (NamesT m Term)
forall (m :: * -> *) a.
(MonadFail m, Subst a) =>
a -> NamesT m (NamesT m a)
open (Term -> NamesT m (NamesT m Term))
-> (NamesT Fail Term -> Term)
-> NamesT Fail Term
-> NamesT m (NamesT m Term)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Names -> NamesT Fail Term -> Term
forall a. Names -> NamesT Fail a -> a
runNames [] (NamesT Fail Term -> NamesT m (NamesT m Term))
-> NamesT Fail Term -> NamesT m (NamesT m Term)
forall a b. (a -> b) -> a -> b
$ String
-> (NamesT Fail Term -> NamesT Fail Term) -> NamesT Fail Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
lam String
"i" (NamesT Fail Term -> NamesT Fail Term -> NamesT Fail Term
forall a b. a -> b -> a
const (Term -> NamesT Fail Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term -> NamesT Fail Term) -> Term -> NamesT Fail Term
forall a b. (a -> b) -> a -> b
$ Arg Term -> Term
forall e. Arg e -> e
unArg Arg Term
a))) [Arg Term
la, Arg Term
lb, Arg Term
bA, Arg Term
phi, Arg Term
bT, Arg Term
e]

        -- Andreas, 2022-03-24, fixing #5838
        -- Following the updated note
        --
        --   Simon Huber, A Cubical Type Theory for Higher Inductive Types
        --   https://simhu.github.io/misc/hcomp.pdf (February 2022)
        --
        -- See: https://github.com/agda/agda/issues/5755#issuecomment-1043797776

        -- unglue_u0 i = unglue la[i/i] lb[i/i] bA[i/i] phi[i/i] bT[i/i] e[i/e] u0
        let unglue_u0 :: NamesT m Term -> NamesT m Term
unglue_u0 NamesT m Term
i =
              (NamesT m Term -> NamesT m Term -> NamesT m Term)
-> NamesT m Term -> [NamesT m Term] -> NamesT m Term
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
(<#>) (Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
tunglue) ((NamesT m Term -> NamesT m Term)
-> [NamesT m Term] -> [NamesT m Term]
forall a b. (a -> b) -> [a] -> [b]
map (NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT m Term
i) [NamesT m Term
la, NamesT m Term
lb, NamesT m Term
bA, NamesT m Term
phi, NamesT m Term
bT, NamesT m Term
e]) NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT m Term
u0

        Term -> IntervalView
view <- NamesT m (Term -> IntervalView)
forall (m :: * -> *). HasBuiltins m => m (Term -> IntervalView)
intervalView'

        NamesT m Bool
-> NamesT m (Maybe Term)
-> NamesT m (Maybe Term)
-> NamesT m (Maybe Term)
forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifM (TermPosition -> NamesT m Term -> NamesT m Bool
forall (m :: * -> *). PureTCM m => TermPosition -> m Term -> m Bool
headStop TermPosition
tpos (NamesT m Term
phi NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
io)) (Maybe Term -> NamesT m (Maybe Term)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Term
forall a. Maybe a
Nothing) (NamesT m (Maybe Term) -> NamesT m (Maybe Term))
-> NamesT m (Maybe Term) -> NamesT m (Maybe Term)
forall a b. (a -> b) -> a -> b
$ Term -> Maybe Term
forall a. a -> Maybe a
Just (Term -> Maybe Term) -> NamesT m Term -> NamesT m (Maybe Term)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
        let
          tf :: NamesT m Term -> NamesT m Term -> NamesT m Term
tf NamesT m Term
i NamesT m Term
o = NamesT m Term
-> NamesT m Term
-> NamesT m Term
-> NamesT m Term
-> NamesT m Term
-> NamesT m Term
transpFill NamesT m Term
lb (String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
lam String
"i" ((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
i -> NamesT m Term
bT NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT m Term
i NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<..> NamesT m Term
o) NamesT m Term
psi NamesT m Term
u0 NamesT m Term
i
          t1 :: NamesT m Term -> NamesT m Term
t1 NamesT m Term
o = NamesT m Term -> NamesT m Term -> NamesT m Term
tf (Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
io) NamesT m Term
o

          -- compute "forall. phi"
          forallphi :: NamesT m Term
forallphi = Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
tForall NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT m Term
phi

          -- a1 with gcomp
          a1 :: NamesT m Term
a1 = NamesT m Term
-> NamesT m Term
-> NamesT m Term
-> NamesT m Term
-> NamesT m Term
-> NamesT m Term
gcomp NamesT m Term
la NamesT m Term
bA
                 (NamesT m Term -> NamesT m Term -> NamesT m Term
imax NamesT m Term
psi NamesT m Term
forallphi)
                 (String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
lam String
"i" ((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
i -> Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
tPOr NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> (NamesT m Term
la NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT m Term
i)
                                             NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT m Term
psi
                                             NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT m Term
forallphi
                                             NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
ilam String
"o" (\ NamesT m Term
_ -> NamesT m Term
bA NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT m Term
i)
                                             NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
ilam String
"o" (\ NamesT m Term
_ -> NamesT m Term -> NamesT m Term
unglue_u0 NamesT m Term
i)
                                             NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
ilam String
"o" (\ NamesT m Term
o -> Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
tEFun NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> (NamesT m Term
lb 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
la NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT m Term
i)
                                                                               NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> (NamesT m Term
bT NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT m Term
i NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<..> NamesT m Term
o)
                                                                               NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> (NamesT m Term
bA NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT m Term
i)
                                                                               NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> (NamesT m Term
e NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT m Term
i NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<..> NamesT m Term
o)
                                                                               NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> (NamesT m Term -> NamesT m Term -> NamesT m Term
tf NamesT m Term
i NamesT m Term
o)))
                 (NamesT m Term -> NamesT m Term
unglue_u0 (Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
iz))

          max :: NamesT m Term -> NamesT m Term -> NamesT m Term
max NamesT m Term
l NamesT m Term
l' = Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
tLMax NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT m Term
l NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT m Term
l'
          sigCon :: NamesT m Term -> NamesT m Term -> NamesT m Term
sigCon NamesT m Term
x NamesT m Term
y = Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ConHead -> ConInfo -> [Elim] -> Term
Con (SigmaKit -> ConHead
sigmaCon SigmaKit
kit) ConInfo
ConOSystem []) NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT m Term
x NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT m Term
y
          w :: NamesT m Term -> NamesT m Term -> NamesT m Term
w NamesT m Term
i NamesT m Term
o = Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
tEFun NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> (NamesT m Term
lb 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
la NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT m Term
i)
                             NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> (NamesT m Term
bT NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT m Term
i NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<..> NamesT m Term
o)
                             NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> (NamesT m Term
bA NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT m Term
i)
                             NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> (NamesT m Term
e NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT m Term
i NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<..> NamesT m Term
o)
          fiber :: NamesT m Term
-> NamesT m Term
-> NamesT m Term
-> NamesT m Term
-> NamesT m Term
-> NamesT m Term
-> NamesT m Term
fiber NamesT m Term
la NamesT m Term
lb NamesT m Term
bA NamesT m Term
bB NamesT m Term
f NamesT m Term
b =
            (Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure (QName -> [Elim] -> Term
Def (SigmaKit -> QName
sigmaName SigmaKit
kit) []) NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> NamesT m Term
la
                                           NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> NamesT m Term
lb
                                           NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT m Term
bA
                                           NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
lam String
"a" (\ NamesT m Term
a -> Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
tPath NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> NamesT m Term
lb NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> NamesT m Term
bB NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> (NamesT m Term
f NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT m Term
a) NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT m Term
b))

          -- We don't have to do anything special for "~ forall. phi"
          -- here (to implement "ghcomp") as it is taken care off by
          -- tEProof in t1'alpha below
          pe :: NamesT m Term -> NamesT m Term
pe NamesT m Term
o = -- o : [ φ 1 ]
            Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
tPOr NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> NamesT m Term -> NamesT m Term -> NamesT m Term
max (NamesT m Term
la NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
io) (NamesT m Term
lb NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
io)
                      NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT m Term
psi
                      NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT m Term
forallphi
                      NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
forall (m :: * -> *).
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
-> NamesT m Term
-> NamesT m Term
fiber (NamesT m Term
lb NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
io) (NamesT m Term
la NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
io)
                                   (NamesT m Term
bT NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> (Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
io) NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<..> NamesT m Term
o) (NamesT m Term
bA NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
io)
                                   (NamesT m Term -> NamesT m Term -> NamesT m Term
w (Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
io) NamesT m Term
o) NamesT m Term
a1)
                      NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
ilam String
"o" (\ NamesT m Term
o -> NamesT m Term -> NamesT m Term -> NamesT m Term
sigCon NamesT m Term
u0 (String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
lam String
"_" ((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
a1))
                      NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
ilam String
"o" (\ NamesT m Term
o -> NamesT m Term -> NamesT m Term -> NamesT m Term
sigCon (NamesT m Term -> NamesT m Term
t1 NamesT m Term
o) (String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
lam String
"_" ((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
a1))

          -- "ghcomp" is implemented in the proof of tEProof
          -- (see src/data/lib/prim/Agda/Builtin/Cubical/Glue.agda)
          t1'alpha :: NamesT m Term -> NamesT m Term
t1'alpha NamesT m Term
o = -- o : [ φ 1 ]
             Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
tEProof NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> (NamesT m Term
lb NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
io)
                          NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> (NamesT m Term
la NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
io)
                          NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> (NamesT m Term
bT NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
io NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<..> NamesT m Term
o)
                          NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> (NamesT m Term
bA NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
io)
                          NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> (NamesT m Term
e NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
io NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<..> NamesT m Term
o)
                          NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT m Term
a1
                          NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> (NamesT m Term -> NamesT m Term -> NamesT m Term
imax NamesT m Term
psi NamesT m Term
forallphi)
                          NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT m Term -> NamesT m Term
pe NamesT m Term
o

          -- TODO: optimize?
          t1' :: NamesT m Term -> NamesT m Term
t1' NamesT m Term
o = NamesT m Term -> NamesT m Term
t1'alpha NamesT m Term
o NamesT m Term -> (Term -> Term) -> NamesT m Term
forall (m :: * -> *) a b. Functor m => m a -> (a -> b) -> m b
<&> (Term -> [Elim] -> Term
forall t. Apply t => t -> [Elim] -> t
`applyE` [ProjOrigin -> QName -> Elim
forall a. ProjOrigin -> QName -> Elim' a
Proj ProjOrigin
ProjSystem (SigmaKit -> QName
sigmaFst SigmaKit
kit)])
          alpha :: NamesT m Term -> NamesT m Term
alpha NamesT m Term
o = NamesT m Term -> NamesT m Term
t1'alpha NamesT m Term
o NamesT m Term -> (Term -> Term) -> NamesT m Term
forall (m :: * -> *) a b. Functor m => m a -> (a -> b) -> m b
<&> (Term -> [Elim] -> Term
forall t. Apply t => t -> [Elim] -> t
`applyE` [ProjOrigin -> QName -> Elim
forall a. ProjOrigin -> QName -> Elim' a
Proj ProjOrigin
ProjSystem (SigmaKit -> QName
sigmaSnd SigmaKit
kit)])
          a1' :: NamesT m Term
a1' = Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
tHComp
                  NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> (NamesT m Term
la NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
io)
                  NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> (NamesT m Term
bA NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
io)
                  NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> (NamesT m Term -> NamesT m Term -> NamesT m Term
imax (NamesT m Term
phi NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
io) NamesT m Term
psi)
                  NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
lam String
"j" (\ NamesT m Term
j ->
                         Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
tPOr NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> (NamesT m Term
la NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
io) NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> (NamesT m Term
phi NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
io) NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT m Term
psi NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
ilam String
"o" (\ NamesT m Term
_ -> NamesT m Term
bA NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
io)
                                   NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> 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
o -> NamesT m Term -> NamesT m Term
alpha NamesT m Term
o NamesT m Term
-> (NamesT m Term, NamesT m Term, NamesT m Term) -> NamesT m Term
forall (m :: * -> *).
Applicative m =>
m Term -> (m Term, m Term, m Term) -> m Term
<@@> (NamesT m Term -> NamesT m Term -> NamesT m Term
w (Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
io) NamesT m Term
o NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT m Term -> NamesT m Term
t1' NamesT m Term
o,NamesT m Term
a1,NamesT m Term
j))
                                   NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
ilam String
"o" (\ NamesT m Term
_ -> NamesT m Term
a1))
                  NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT m Term
a1

        -- glue1 (ilam "o" t1') a1'
        case TermPosition
tpos of
          TermPosition
Head -> NamesT m Term -> NamesT m Term
t1' (Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
tItIsOne)
          TermPosition
Eliminated -> NamesT m Term
a1'
compGlue TranspOrHComp
cmd Arg Term
phi Maybe (Arg Term)
u Arg Term
u0 FamilyOrNot
  (Arg Term, Arg Term, Arg Term, Arg Term, Arg Term, Arg Term)
_ TermPosition
_ = m (Maybe Term)
forall a. HasCallStack => a
__IMPOSSIBLE__

compHCompU :: PureTCM m =>
                    TranspOrHComp
                    -> Arg Term
                    -> Maybe (Arg Term)
                    -> Arg Term
                    -> FamilyOrNot (Arg Term, Arg Term, Arg Term, Arg Term)
                    -> TermPosition
                    -> m (Maybe Term)

compHCompU :: TranspOrHComp
-> Arg Term
-> Maybe (Arg Term)
-> Arg Term
-> FamilyOrNot (Arg Term, Arg Term, Arg Term, Arg Term)
-> TermPosition
-> m (Maybe Term)
compHCompU TranspOrHComp
DoHComp Arg Term
psi (Just Arg Term
u) Arg Term
u0 (IsNot (Arg Term
la, Arg Term
phi, Arg Term
bT, Arg Term
bA)) TermPosition
tpos = do
      let getTermLocal :: String -> m Term
getTermLocal = String -> String -> m Term
forall (m :: * -> *). HasBuiltins m => String -> String -> m Term
getTerm (String -> String -> m Term) -> String -> String -> m Term
forall a b. (a -> b) -> a -> b
$ (String
builtinHComp String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" for " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
builtinHComp String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" of Set")
      Term
io      <- String -> m Term
getTermLocal String
builtinIOne
      Term
iz      <- String -> m Term
getTermLocal String
builtinIZero
      Term
tPOr <- String -> m Term
getTermLocal String
"primPOr"
      Term
tIMax <- String -> m Term
getTermLocal String
builtinIMax
      Term
tIMin <- String -> m Term
getTermLocal String
builtinIMin
      Term
tINeg <- String -> m Term
getTermLocal String
builtinINeg
      Term
tHComp <- String -> m Term
getTermLocal String
builtinHComp
      Term
tTransp  <- String -> m Term
getTermLocal String
builtinTrans
      Term
tglue   <- String -> m Term
getTermLocal String
builtin_glueU
      Term
tunglue <- String -> m Term
getTermLocal String
builtin_unglueU
      Term
tLSuc   <- String -> m Term
getTermLocal String
builtinLevelSuc
      Term
tSubIn <- String -> m Term
getTermLocal String
builtinSubIn
      Term
tItIsOne <- String -> m Term
getTermLocal String
builtinItIsOne
      Names -> NamesT m (Maybe Term) -> m (Maybe Term)
forall (m :: * -> *) a. Names -> NamesT m a -> m a
runNamesT [] (NamesT m (Maybe Term) -> m (Maybe Term))
-> NamesT m (Maybe Term) -> m (Maybe Term)
forall a b. (a -> b) -> a -> b
$ do
        [NamesT m Term
psi, NamesT m Term
u, NamesT m Term
u0] <- (Arg Term -> NamesT m (NamesT m Term))
-> [Arg Term] -> NamesT m [NamesT m Term]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Term -> NamesT m (NamesT m Term)
forall (m :: * -> *) a.
(MonadFail m, Subst a) =>
a -> NamesT m (NamesT m a)
open (Term -> NamesT m (NamesT m Term))
-> (Arg Term -> Term) -> Arg Term -> NamesT m (NamesT m Term)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Arg Term -> Term
forall e. Arg e -> e
unArg) [Arg Term
psi, Arg Term
u, Arg Term
u0]
        [NamesT m Term
la, NamesT m Term
phi, NamesT m Term
bT, NamesT m Term
bA] <- (Arg Term -> NamesT m (NamesT m Term))
-> [Arg Term] -> NamesT m [NamesT m Term]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Term -> NamesT m (NamesT m Term)
forall (m :: * -> *) a.
(MonadFail m, Subst a) =>
a -> NamesT m (NamesT m a)
open (Term -> NamesT m (NamesT m Term))
-> (Arg Term -> Term) -> Arg Term -> NamesT m (NamesT m Term)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Arg Term -> Term
forall e. Arg e -> e
unArg) [Arg Term
la, Arg Term
phi, Arg Term
bT, Arg Term
bA]

        NamesT m Bool
-> NamesT m (Maybe Term)
-> NamesT m (Maybe Term)
-> NamesT m (Maybe Term)
forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifM (TermPosition -> NamesT m Term -> NamesT m Bool
forall (m :: * -> *). PureTCM m => TermPosition -> m Term -> m Bool
headStop TermPosition
tpos NamesT m Term
phi) (Maybe Term -> NamesT m (Maybe Term)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Term
forall a. Maybe a
Nothing) (NamesT m (Maybe Term) -> NamesT m (Maybe Term))
-> NamesT m (Maybe Term) -> NamesT m (Maybe Term)
forall a b. (a -> b) -> a -> b
$ Term -> Maybe Term
forall a. a -> Maybe a
Just (Term -> Maybe Term) -> NamesT m Term -> NamesT m (Maybe Term)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do

        let
          hfill :: NamesT m Term
-> NamesT m Term
-> NamesT m Term
-> NamesT m Term
-> NamesT m Term
-> NamesT m Term
-> NamesT m Term
hfill NamesT m Term
la NamesT m Term
bA NamesT m Term
phi NamesT m Term
u NamesT m Term
u0 NamesT m Term
i = Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
tHComp NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> NamesT m Term
la
                                               NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> NamesT m Term
bA
                                               NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> (Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
tIMax NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT m Term
phi NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> (Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
tINeg 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
<@> String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
lam String
"j" (\ NamesT m Term
j -> Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
tPOr NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> NamesT m Term
la NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT m Term
phi NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> (Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
tINeg 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
<@> 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
a -> NamesT m Term
bA)
                                                     NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
ilam String
"o" (\ NamesT m Term
o -> NamesT m Term
u NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> (Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
tIMin 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) NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<..> NamesT m Term
o)
                                                     NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> 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
u0))
                                               NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT m Term
u0
          transp :: NamesT m Term
-> (NamesT m Term -> NamesT m Term)
-> NamesT m Term
-> NamesT m Term
transp NamesT m Term
la NamesT m Term -> NamesT m Term
bA NamesT m Term
a0 = Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
tTransp NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
lam String
"i" (NamesT m Term -> NamesT m Term -> NamesT m Term
forall a b. a -> b -> a
const NamesT m Term
la) NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
lam String
"i" NamesT m Term -> NamesT m Term
bA NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
iz NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT m Term
a0
          tf :: NamesT m Term -> NamesT m Term -> NamesT m Term
tf NamesT m Term
i NamesT m Term
o = NamesT m Term
-> NamesT m Term
-> NamesT m Term
-> NamesT m Term
-> NamesT m Term
-> NamesT m Term
-> NamesT m Term
hfill NamesT m Term
la (NamesT m Term
bT NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
io NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<..> NamesT m Term
o) NamesT m Term
psi NamesT m Term
u NamesT m Term
u0 NamesT m Term
i
          bAS :: NamesT m Term
bAS = Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
tSubIn NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> (Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
tLSuc NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT m Term
la) NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> (Sort' Term -> Term
Sort (Sort' Term -> Term) -> (Term -> Sort' Term) -> Term -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term -> Sort' Term
tmSort (Term -> Term) -> NamesT m Term -> NamesT m Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamesT m Term
la) NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> NamesT m Term
phi NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT m Term
bA
          unglue :: NamesT m Term -> NamesT m Term
unglue NamesT m Term
g = Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
tunglue NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> NamesT m Term
la NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> NamesT m Term
phi NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> NamesT m Term
bT NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> NamesT m Term
bAS NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT m Term
g
          a1 :: NamesT m Term
a1 = Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
tHComp NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> NamesT m Term
la NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> NamesT m Term
bA NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> (Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
tIMax NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT m Term
psi NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT m Term
phi)
                           NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
lam String
"i" (\ NamesT m Term
i -> Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
tPOr NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> NamesT m Term
la NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT m Term
psi NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT m Term
phi NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
ilam String
"_" (\ NamesT m Term
_ -> NamesT m Term
bA)
                                 NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> 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
o -> NamesT m Term -> NamesT m Term
unglue (NamesT m Term
u NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT m Term
i NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<..> NamesT m Term
o))
                                 NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> 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
o -> NamesT m Term
-> (NamesT m Term -> NamesT m Term)
-> NamesT m Term
-> NamesT m Term
transp NamesT m Term
la (\ NamesT m Term
i -> NamesT m Term
bT NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> (Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
tINeg NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT m Term
i) NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<..> NamesT m Term
o) (NamesT m Term -> NamesT m Term -> NamesT m Term
tf NamesT m Term
i NamesT m Term
o)))
                           NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT m Term -> NamesT m Term
unglue NamesT m Term
u0
          t1 :: NamesT m Term -> NamesT m Term
t1 = NamesT m Term -> NamesT m Term -> NamesT m Term
tf (Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
io)

        -- pure tglue <#> la <#> phi <#> bT <#> bAS <@> (ilam "o" $ \ o -> t1 o) <@> a1
        case TermPosition
tpos of
          TermPosition
Eliminated -> NamesT m Term
a1
          TermPosition
Head       -> NamesT m Term -> NamesT m Term
t1 (Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
tItIsOne)



compHCompU TranspOrHComp
DoTransp Arg Term
psi Maybe (Arg Term)
Nothing Arg Term
u0 (IsFam (Arg Term
la, Arg Term
phi, Arg Term
bT, Arg Term
bA)) TermPosition
tpos = do
      let
        localUse :: String
localUse = String
builtinTrans String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" for " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
builtinHComp String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" of Set"
        getTermLocal :: String -> m Term
getTermLocal = String -> String -> m Term
forall (m :: * -> *). HasBuiltins m => String -> String -> m Term
getTerm String
localUse
      Term
tPOr <- String -> m Term
getTermLocal String
"primPOr"
      Term
tIMax <- String -> m Term
getTermLocal String
builtinIMax
      Term
tIMin <- String -> m Term
getTermLocal String
builtinIMin
      Term
tINeg <- String -> m Term
getTermLocal String
builtinINeg
      Term
tHComp <- String -> m Term
getTermLocal String
builtinHComp
      Term
tTrans <- String -> m Term
getTermLocal String
builtinTrans
      Term
tTranspProof <- String -> m Term
getTermLocal String
builtinTranspProof
      Term
tSubIn <- String -> m Term
getTermLocal String
builtinSubIn
      Term
tForall  <- String -> m Term
getTermLocal String
builtinFaceForall
      Term
io      <- String -> m Term
getTermLocal String
builtinIOne
      Term
iz      <- String -> m Term
getTermLocal String
builtinIZero
      Term
tLSuc   <- String -> m Term
getTermLocal String
builtinLevelSuc
      Term
tPath   <- String -> m Term
getTermLocal String
builtinPath
      Term
tItIsOne   <- String -> m Term
getTermLocal String
builtinItIsOne
      SigmaKit
kit <- SigmaKit -> Maybe SigmaKit -> SigmaKit
forall a. a -> Maybe a -> a
fromMaybe SigmaKit
forall a. HasCallStack => a
__IMPOSSIBLE__ (Maybe SigmaKit -> SigmaKit) -> m (Maybe SigmaKit) -> m SigmaKit
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (Maybe SigmaKit)
forall (m :: * -> *).
(HasBuiltins m, HasConstInfo m) =>
m (Maybe SigmaKit)
getSigmaKit
      Names -> NamesT m (Maybe Term) -> m (Maybe Term)
forall (m :: * -> *) a. Names -> NamesT m a -> m a
runNamesT [] (NamesT m (Maybe Term) -> m (Maybe Term))
-> NamesT m (Maybe Term) -> m (Maybe Term)
forall a b. (a -> b) -> a -> b
$ do
        let ineg :: NamesT m Term -> NamesT m Term
ineg NamesT m Term
j = Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
tINeg NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT m Term
j
            imax :: NamesT m Term -> NamesT m Term -> NamesT m Term
imax NamesT m Term
i NamesT m Term
j = Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
tIMax 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
            imin :: NamesT m Term -> NamesT m Term -> NamesT m Term
imin NamesT m Term
i NamesT m Term
j = Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
tIMin 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
            transp :: NamesT m Term
-> (NamesT m Term -> NamesT m Term)
-> NamesT m Term
-> NamesT m Term
transp NamesT m Term
la NamesT m Term -> NamesT m Term
bA NamesT m Term
a0 = Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
tTrans NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
lam String
"i" (NamesT m Term -> NamesT m Term -> NamesT m Term
forall a b. a -> b -> a
const NamesT m Term
la) NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
lam String
"i" NamesT m Term -> NamesT m Term
bA NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
iz NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT m Term
a0

        NamesT m Term
-> NamesT m Term
-> NamesT m Term
-> NamesT m Term
-> NamesT m Term
-> NamesT m Term
gcomp <- String
-> NamesT
     m
     (NamesT m Term
      -> NamesT m Term
      -> NamesT m Term
      -> NamesT m Term
      -> NamesT m Term
      -> NamesT m 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)
mkGComp String
localUse

        let transpFill :: NamesT m Term
-> NamesT m Term
-> NamesT m Term
-> NamesT m Term
-> NamesT m Term
-> NamesT m Term
transpFill NamesT m Term
la NamesT m Term
bA NamesT m Term
phi NamesT m Term
u0 NamesT m Term
i =
              Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
tTrans NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
ilam String
"j" (\ NamesT m Term
j -> NamesT m Term
la NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT m Term -> NamesT m Term -> NamesT m Term
imin NamesT m Term
i NamesT m Term
j)
                          NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
ilam String
"j" (\ NamesT m Term
j -> NamesT m Term
bA NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT m Term -> NamesT m Term -> NamesT m Term
imin NamesT m Term
i NamesT m Term
j)
                          NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> (NamesT m Term -> NamesT m Term -> NamesT m Term
imax NamesT m Term
phi (NamesT m Term -> NamesT m Term
ineg 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
u0
        [NamesT m Term
psi,NamesT m Term
u0] <- (Arg Term -> NamesT m (NamesT m Term))
-> [Arg Term] -> NamesT m [NamesT m Term]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Term -> NamesT m (NamesT m Term)
forall (m :: * -> *) a.
(MonadFail m, Subst a) =>
a -> NamesT m (NamesT m a)
open (Term -> NamesT m (NamesT m Term))
-> (Arg Term -> Term) -> Arg Term -> NamesT m (NamesT m Term)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Arg Term -> Term
forall e. Arg e -> e
unArg) [Arg Term
psi,Arg Term
u0]
        NamesT m Term -> NamesT m Term -> NamesT m Term
glue1 <- do
          Term
tglue   <- m Term -> NamesT m Term
forall (m :: * -> *) a. Monad m => m a -> NamesT m a
cl (m Term -> NamesT m Term) -> m Term -> NamesT m Term
forall a b. (a -> b) -> a -> b
$ String -> m Term
getTermLocal String
builtin_glueU
          [NamesT m Term
la, NamesT m Term
phi, NamesT m Term
bT, NamesT m Term
bA] <- (Arg Term -> NamesT m (NamesT m Term))
-> [Arg Term] -> NamesT m [NamesT m Term]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Term -> NamesT m (NamesT m Term)
forall (m :: * -> *) a.
(MonadFail m, Subst a) =>
a -> NamesT m (NamesT m a)
open (Term -> NamesT m (NamesT m Term))
-> (Arg Term -> Term) -> Arg Term -> NamesT m (NamesT m Term)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Arg Term -> Term
forall e. Arg e -> e
unArg (Arg Term -> Term) -> (Arg Term -> Arg Term) -> Arg Term -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Arity -> SubstArg (Arg Term) -> Arg Term -> Arg Term
forall a. Subst a => Arity -> SubstArg a -> a -> a
subst Arity
0 Term
SubstArg (Arg Term)
io) ([Arg Term] -> NamesT m [NamesT m Term])
-> [Arg Term] -> NamesT m [NamesT m Term]
forall a b. (a -> b) -> a -> b
$ [Arg Term
la, Arg Term
phi, Arg Term
bT, Arg Term
bA]
          let bAS :: NamesT m Term
bAS = Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
tSubIn NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> (Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
tLSuc NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT m Term
la) NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> (Sort' Term -> Term
Sort (Sort' Term -> Term) -> (Term -> Sort' Term) -> Term -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term -> Sort' Term
tmSort (Term -> Term) -> NamesT m Term -> NamesT m Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamesT m Term
la) NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> NamesT m Term
phi NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT m Term
bA
          NamesT m Term
g <- (Term -> NamesT m (NamesT m Term)
forall (m :: * -> *) a.
(MonadFail m, Subst a) =>
a -> NamesT m (NamesT m a)
open (Term -> NamesT m (NamesT m Term))
-> NamesT m Term -> NamesT m (NamesT m Term)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (NamesT m Term -> NamesT m (NamesT m Term))
-> NamesT m Term -> NamesT m (NamesT m Term)
forall a b. (a -> b) -> a -> b
$ Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
tglue NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> NamesT m Term
la NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> NamesT m Term
phi NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> NamesT m Term
bT NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> NamesT m Term
bAS
          (NamesT m Term -> NamesT m Term -> NamesT m Term)
-> NamesT m (NamesT m Term -> NamesT m Term -> NamesT m Term)
forall (m :: * -> *) a. Monad m => a -> m a
return ((NamesT m Term -> NamesT m Term -> NamesT m Term)
 -> NamesT m (NamesT m Term -> NamesT m Term -> NamesT m Term))
-> (NamesT m Term -> NamesT m Term -> NamesT m Term)
-> NamesT m (NamesT m Term -> NamesT m Term -> NamesT m Term)
forall a b. (a -> b) -> a -> b
$ \ NamesT m Term
t NamesT m Term
a -> NamesT m Term
g NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT m Term
t NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT m Term
a

        [NamesT m Term
la, NamesT m Term
phi, NamesT m Term
bT, NamesT m Term
bA] <- (Arg Term -> NamesT m (NamesT m Term))
-> [Arg Term] -> NamesT m [NamesT m Term]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\ Arg Term
a -> Term -> NamesT m (NamesT m Term)
forall (m :: * -> *) a.
(MonadFail m, Subst a) =>
a -> NamesT m (NamesT m a)
open (Term -> NamesT m (NamesT m Term))
-> (NamesT Fail Term -> Term)
-> NamesT Fail Term
-> NamesT m (NamesT m Term)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Names -> NamesT Fail Term -> Term
forall a. Names -> NamesT Fail a -> a
runNames [] (NamesT Fail Term -> NamesT m (NamesT m Term))
-> NamesT Fail Term -> NamesT m (NamesT m Term)
forall a b. (a -> b) -> a -> b
$ String
-> (NamesT Fail Term -> NamesT Fail Term) -> NamesT Fail Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
lam String
"i" (NamesT Fail Term -> NamesT Fail Term -> NamesT Fail Term
forall a b. a -> b -> a
const (Term -> NamesT Fail Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term -> NamesT Fail Term) -> Term -> NamesT Fail Term
forall a b. (a -> b) -> a -> b
$ Arg Term -> Term
forall e. Arg e -> e
unArg Arg Term
a))) [Arg Term
la, Arg Term
phi, Arg Term
bT, Arg Term
bA]

        -- Andreas, 2022-03-25, issue #5838.
        -- Port the fix of @unglueTranspGlue@ and @compGlue DoTransp@
        -- also to @compHCompU DoTransp@, as suggested by Tom Jack and Anders Mörtberg.
        -- We define @unglue_u0 i@ that is first used with @i@ and then with @i0@.
        -- The original code used it only with @i0@.
        Term
tunglue <- m Term -> NamesT m Term
forall (m :: * -> *) a. Monad m => m a -> NamesT m a
cl (m Term -> NamesT m Term) -> m Term -> NamesT m Term
forall a b. (a -> b) -> a -> b
$ String -> m Term
getTermLocal String
builtin_unglueU
        let bAS :: NamesT m Term -> NamesT m Term
bAS NamesT m Term
i =
              Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
tSubIn  NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> (Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
tLSuc NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> (NamesT m Term
la NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT m Term
i))
                           NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> (Sort' Term -> Term
Sort (Sort' Term -> Term) -> (Term -> Sort' Term) -> Term -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term -> Sort' Term
tmSort (Term -> Term) -> NamesT m Term -> NamesT m Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (NamesT m Term
la NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT m Term
i))
                           NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> (NamesT m Term
phi NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT m Term
i)
                           NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> (NamesT m Term
bA NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT m Term
i)
        let unglue_u0 :: NamesT m Term -> NamesT m Term
unglue_u0 NamesT m Term
i =
              Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
tunglue NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> (NamesT m Term
la NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT m Term
i)
                           NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> (NamesT m Term
phi NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT m Term
i)
                           NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> (NamesT m Term
bT 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 -> NamesT m Term
bAS 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
u0

        NamesT m Bool
-> NamesT m (Maybe Term)
-> NamesT m (Maybe Term)
-> NamesT m (Maybe Term)
forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifM (TermPosition -> NamesT m Term -> NamesT m Bool
forall (m :: * -> *). PureTCM m => TermPosition -> m Term -> m Bool
headStop TermPosition
tpos (NamesT m Term
phi NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
io)) (Maybe Term -> NamesT m (Maybe Term)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Term
forall a. Maybe a
Nothing) (NamesT m (Maybe Term) -> NamesT m (Maybe Term))
-> NamesT m (Maybe Term) -> NamesT m (Maybe Term)
forall a b. (a -> b) -> a -> b
$ Term -> Maybe Term
forall a. a -> Maybe a
Just (Term -> Maybe Term) -> NamesT m Term -> NamesT m (Maybe Term)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do

        let
          lb :: NamesT m Term
lb = NamesT m Term
la
          tf :: NamesT m Term -> NamesT m Term -> NamesT m Term
tf NamesT m Term
i NamesT m Term
o = NamesT m Term
-> NamesT m Term
-> NamesT m Term
-> NamesT m Term
-> NamesT m Term
-> NamesT m Term
transpFill NamesT m Term
lb (String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
lam String
"i" ((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
i -> NamesT m Term
bT 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
<@> Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
io NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<..> NamesT m Term
o) NamesT m Term
psi NamesT m Term
u0 NamesT m Term
i
          t1 :: NamesT m Term -> NamesT m Term
t1 NamesT m Term
o = NamesT m Term -> NamesT m Term -> NamesT m Term
tf (Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
io) NamesT m Term
o

          -- compute "forall. phi"
          forallphi :: NamesT m Term
forallphi = Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
tForall NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT m Term
phi

          -- a1 with gcomp
          a1 :: NamesT m Term
a1 = NamesT m Term
-> NamesT m Term
-> NamesT m Term
-> NamesT m Term
-> NamesT m Term
-> NamesT m Term
gcomp NamesT m Term
la NamesT m Term
bA
                 (NamesT m Term -> NamesT m Term -> NamesT m Term
imax NamesT m Term
psi NamesT m Term
forallphi)
                 (String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
lam String
"i" ((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
i -> Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
tPOr NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> (NamesT m Term
la NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT m Term
i)
                                             NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT m Term
psi
                                             NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT m Term
forallphi
                                             NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
ilam String
"o" (\ NamesT m Term
_ -> NamesT m Term
bA NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT m Term
i)
                                             NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
ilam String
"o" (\ NamesT m Term
_ -> NamesT m Term -> NamesT m Term
unglue_u0 NamesT m Term
i)
                                             NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
ilam String
"o" (\ NamesT m Term
o -> NamesT m Term
-> (NamesT m Term -> NamesT m Term)
-> NamesT m Term
-> NamesT m Term
transp (NamesT m Term
la NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT m Term
i)
                                                                           (\ NamesT m Term
j -> NamesT m Term
bT 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 -> NamesT m Term
ineg NamesT m Term
j NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<..> NamesT m Term
o)
                                                                           (NamesT m Term -> NamesT m Term -> NamesT m Term
tf NamesT m Term
i NamesT m Term
o)))
                 (NamesT m Term -> NamesT m Term
unglue_u0 (Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
iz))

          w :: NamesT m Term -> NamesT m Term -> NamesT m Term
w NamesT m Term
i NamesT m Term
o = String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
lam String
"x" ((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 -> NamesT m Term)
-> NamesT m Term
-> NamesT m Term
transp (NamesT m Term
la NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT m Term
i)
                         (\ NamesT m Term
j -> NamesT m Term
bT 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 -> NamesT m Term
ineg NamesT m Term
j NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<..> NamesT m Term
o)

          pt :: NamesT m Term -> NamesT m Term
pt NamesT m Term
o = -- o : [ φ 1 ]
            Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
tPOr NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> (NamesT m Term
la NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
io)
                      NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT m Term
psi
                      NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT m Term
forallphi
                      NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
ilam String
"o" (\ NamesT m Term
_ -> NamesT m Term
bT NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
io NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
io NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<..> NamesT m Term
o)
                      NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
ilam String
"o" (\ NamesT m Term
o -> NamesT m Term
u0)
                      NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
ilam String
"o" (\ NamesT m Term
o -> NamesT m Term -> NamesT m Term
t1 NamesT m Term
o)

          -- "ghcomp" is implemented in the proof of tTranspProof
          -- (see src/data/lib/prim/Agda/Builtin/Cubical/HCompU.agda)
          t1'alpha :: NamesT m Term -> NamesT m Term
t1'alpha NamesT m Term
o = -- o : [ φ 1 ]
             Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
tTranspProof NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> (NamesT m Term
la NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
io)
                               NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
lam String
"i" (\ NamesT m Term
i -> NamesT m Term
bT NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
io NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT m Term -> NamesT m Term
ineg NamesT m Term
i NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<..> NamesT m Term
o)
                               NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT m Term -> NamesT m Term -> NamesT m Term
imax NamesT m Term
psi NamesT m Term
forallphi
                               NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT m Term -> NamesT m Term
pt NamesT m Term
o
                               NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> (Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
tSubIn NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> (NamesT m Term
la NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
io) NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> (NamesT m Term
bA NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
io)
                                                NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> NamesT m Term -> NamesT m Term -> NamesT m Term
imax NamesT m Term
psi NamesT m Term
forallphi
                                                NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT m Term
a1)

          -- TODO: optimize?
          t1' :: NamesT m Term -> NamesT m Term
t1' NamesT m Term
o = NamesT m Term -> NamesT m Term
t1'alpha NamesT m Term
o NamesT m Term -> (Term -> Term) -> NamesT m Term
forall (m :: * -> *) a b. Functor m => m a -> (a -> b) -> m b
<&> (Term -> [Elim] -> Term
forall t. Apply t => t -> [Elim] -> t
`applyE` [ProjOrigin -> QName -> Elim
forall a. ProjOrigin -> QName -> Elim' a
Proj ProjOrigin
ProjSystem (SigmaKit -> QName
sigmaFst SigmaKit
kit)])
          alpha :: NamesT m Term -> NamesT m Term
alpha NamesT m Term
o = NamesT m Term -> NamesT m Term
t1'alpha NamesT m Term
o NamesT m Term -> (Term -> Term) -> NamesT m Term
forall (m :: * -> *) a b. Functor m => m a -> (a -> b) -> m b
<&> (Term -> [Elim] -> Term
forall t. Apply t => t -> [Elim] -> t
`applyE` [ProjOrigin -> QName -> Elim
forall a. ProjOrigin -> QName -> Elim' a
Proj ProjOrigin
ProjSystem (SigmaKit -> QName
sigmaSnd SigmaKit
kit)])
          a1' :: NamesT m Term
a1' = Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
tHComp
                  NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> (NamesT m Term
la NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
io)
                  NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> (NamesT m Term
bA NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
io)
                  NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> (NamesT m Term -> NamesT m Term -> NamesT m Term
imax (NamesT m Term
phi NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
io) NamesT m Term
psi)
                  NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
lam String
"j" (\ NamesT m Term
j ->
                         Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
tPOr NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> (NamesT m Term
la NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
io) NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> (NamesT m Term
phi NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
io) NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT m Term
psi NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
ilam String
"o" (\ NamesT m Term
_ -> NamesT m Term
bA NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
io)
                                   NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> 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
o -> NamesT m Term -> NamesT m Term
alpha NamesT m Term
o NamesT m Term
-> (NamesT m Term, NamesT m Term, NamesT m Term) -> NamesT m Term
forall (m :: * -> *).
Applicative m =>
m Term -> (m Term, m Term, m Term) -> m Term
<@@> (NamesT m Term -> NamesT m Term -> NamesT m Term
w (Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
io) NamesT m Term
o NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT m Term -> NamesT m Term
t1' NamesT m Term
o,NamesT m Term
a1,NamesT m Term
j))
                                   NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
ilam String
"o" (\ NamesT m Term
_ -> NamesT m Term
a1))
                  NamesT m Term -> NamesT m Term -> NamesT m Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT m Term
a1

        -- glue1 (ilam "o" t1') a1'
        case TermPosition
tpos of
          TermPosition
Eliminated -> NamesT m Term
a1'
          TermPosition
Head       -> NamesT m Term -> NamesT m Term
t1' (Term -> NamesT m Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
tItIsOne)
compHCompU TranspOrHComp
_ Arg Term
psi Maybe (Arg Term)
_ Arg Term
u0 FamilyOrNot (Arg Term, Arg Term, Arg Term, Arg Term)
_ TermPosition
_ = m (Maybe Term)
forall a. HasCallStack => a
__IMPOSSIBLE__


primTransHComp :: TranspOrHComp -> [Arg Term] -> Int -> ReduceM (Reduced MaybeReducedArgs Term)
primTransHComp :: TranspOrHComp
-> [Arg Term] -> Arity -> ReduceM (Reduced MaybeReducedArgs Term)
primTransHComp TranspOrHComp
cmd [Arg Term]
ts Arity
nelims = do
  (FamilyOrNot (Arg Term)
l,FamilyOrNot (Arg Term)
bA,Arg Term
phi,Maybe (Arg Term)
u,Arg Term
u0) <- case (TranspOrHComp
cmd,[Arg Term]
ts) of
        (TranspOrHComp
DoTransp, [Arg Term
l,Arg Term
bA,Arg Term
phi,  Arg Term
u0]) -> do
          -- u <- runNamesT [] $ do
          --       u0 <- open $ unArg u0
          --       defaultArg <$> (ilam "o" $ \ _ -> u0)
          (FamilyOrNot (Arg Term), FamilyOrNot (Arg Term), Arg Term,
 Maybe (Arg Term), Arg Term)
-> ReduceM
     (FamilyOrNot (Arg Term), FamilyOrNot (Arg Term), Arg Term,
      Maybe (Arg Term), Arg Term)
forall (m :: * -> *) a. Monad m => a -> m a
return ((FamilyOrNot (Arg Term), FamilyOrNot (Arg Term), Arg Term,
  Maybe (Arg Term), Arg Term)
 -> ReduceM
      (FamilyOrNot (Arg Term), FamilyOrNot (Arg Term), Arg Term,
       Maybe (Arg Term), Arg Term))
-> (FamilyOrNot (Arg Term), FamilyOrNot (Arg Term), Arg Term,
    Maybe (Arg Term), Arg Term)
-> ReduceM
     (FamilyOrNot (Arg Term), FamilyOrNot (Arg Term), Arg Term,
      Maybe (Arg Term), Arg Term)
forall a b. (a -> b) -> a -> b
$ (Arg Term -> FamilyOrNot (Arg Term)
forall a. a -> FamilyOrNot a
IsFam Arg Term
l,Arg Term -> FamilyOrNot (Arg Term)
forall a. a -> FamilyOrNot a
IsFam Arg Term
bA,Arg Term
phi,Maybe (Arg Term)
forall a. Maybe a
Nothing,Arg Term
u0)
        (TranspOrHComp
DoHComp, [Arg Term
l,Arg Term
bA,Arg Term
phi,Arg Term
u,Arg Term
u0]) -> do
          -- [l,bA] <- runNamesT [] $ do
          --   forM [l,bA] $ \ a -> do
          --     let info = argInfo a
          --     a <- open $ unArg a
          --     Arg info <$> (lam "i" $ \ _ -> a)
          (FamilyOrNot (Arg Term), FamilyOrNot (Arg Term), Arg Term,
 Maybe (Arg Term), Arg Term)
-> ReduceM
     (FamilyOrNot (Arg Term), FamilyOrNot (Arg Term), Arg Term,
      Maybe (Arg Term), Arg Term)
forall (m :: * -> *) a. Monad m => a -> m a
return ((FamilyOrNot (Arg Term), FamilyOrNot (Arg Term), Arg Term,
  Maybe (Arg Term), Arg Term)
 -> ReduceM
      (FamilyOrNot (Arg Term), FamilyOrNot (Arg Term), Arg Term,
       Maybe (Arg Term), Arg Term))
-> (FamilyOrNot (Arg Term), FamilyOrNot (Arg Term), Arg Term,
    Maybe (Arg Term), Arg Term)
-> ReduceM
     (FamilyOrNot (Arg Term), FamilyOrNot (Arg Term), Arg Term,
      Maybe (Arg Term), Arg Term)
forall a b. (a -> b) -> a -> b
$ (Arg Term -> FamilyOrNot (Arg Term)
forall a. a -> FamilyOrNot a
IsNot Arg Term
l,Arg Term -> FamilyOrNot (Arg Term)
forall a. a -> FamilyOrNot a
IsNot Arg Term
bA,Arg Term
phi,Arg Term -> Maybe (Arg Term)
forall a. a -> Maybe a
Just Arg Term
u,Arg Term
u0)
        (TranspOrHComp, [Arg Term])
_                          -> ReduceM
  (FamilyOrNot (Arg Term), FamilyOrNot (Arg Term), Arg Term,
   Maybe (Arg Term), Arg Term)
forall a. HasCallStack => a
__IMPOSSIBLE__
  Blocked (Arg Term)
sphi <- Arg Term -> ReduceM (Blocked (Arg Term))
forall t. Reduce t => t -> ReduceM (Blocked t)
reduceB' Arg Term
phi
  IntervalView
vphi <- Term -> ReduceM IntervalView
forall (m :: * -> *). HasBuiltins m => Term -> m IntervalView
intervalView (Term -> ReduceM IntervalView) -> Term -> ReduceM IntervalView
forall a b. (a -> b) -> a -> b
$ Arg Term -> Term
forall e. Arg e -> e
unArg (Arg Term -> Term) -> Arg Term -> Term
forall a b. (a -> b) -> a -> b
$ Blocked (Arg Term) -> Arg Term
forall t a. Blocked' t a -> a
ignoreBlocking Blocked (Arg Term)
sphi
  let clP :: String -> NamesT ReduceM Term
clP String
s = String -> String -> NamesT ReduceM Term
forall (m :: * -> *). HasBuiltins m => String -> String -> m Term
getTerm (TranspOrHComp -> String
cmdToName TranspOrHComp
cmd) String
s

  -- WORK
  case IntervalView
vphi of
     IntervalView
IOne -> Term -> ReduceM (Reduced MaybeReducedArgs Term)
forall a a'. a -> ReduceM (Reduced a' a)
redReturn (Term -> ReduceM (Reduced MaybeReducedArgs Term))
-> ReduceM Term -> ReduceM (Reduced MaybeReducedArgs Term)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< case Maybe (Arg Term)
u of
                            -- cmd == DoComp
                            Just Arg Term
u -> Names -> NamesT ReduceM Term -> ReduceM Term
forall (m :: * -> *) a. Names -> NamesT m a -> m a
runNamesT [] (NamesT ReduceM Term -> ReduceM Term)
-> NamesT ReduceM Term -> ReduceM Term
forall a b. (a -> b) -> a -> b
$ do
                                       NamesT ReduceM Term
u <- Term -> NamesT ReduceM (NamesT ReduceM Term)
forall (m :: * -> *) a.
(MonadFail m, Subst a) =>
a -> NamesT m (NamesT m a)
open (Arg Term -> Term
forall e. Arg e -> e
unArg Arg Term
u)
                                       NamesT ReduceM Term
u NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> String -> NamesT ReduceM Term
clP String
builtinIOne NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<..> String -> NamesT ReduceM Term
clP String
builtinItIsOne
                            -- cmd == DoTransp
                            Maybe (Arg Term)
Nothing -> Term -> ReduceM Term
forall (m :: * -> *) a. Monad m => a -> m a
return (Term -> ReduceM Term) -> Term -> ReduceM Term
forall a b. (a -> b) -> a -> b
$ Arg Term -> Term
forall e. Arg e -> e
unArg Arg Term
u0
     IntervalView
_    -> do
       let fallback' :: Blocked (Arg Term) -> ReduceM (Reduced MaybeReducedArgs Term)
fallback' Blocked (Arg Term)
sc = do
             MaybeReducedArgs
u' <- case Maybe (Arg Term)
u of
                            -- cmd == DoComp
                     Just Arg Term
u ->
                              (MaybeReduced (Arg Term) -> MaybeReducedArgs -> MaybeReducedArgs
forall a. a -> [a] -> [a]
:[]) (MaybeReduced (Arg Term) -> MaybeReducedArgs)
-> ReduceM (MaybeReduced (Arg Term)) -> ReduceM MaybeReducedArgs
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case IntervalView
vphi of
                                          IntervalView
IZero -> (Term -> MaybeReduced (Arg Term))
-> ReduceM Term -> ReduceM (MaybeReduced (Arg Term))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Blocked (Arg Term) -> MaybeReduced (Arg Term)
reduced (Blocked (Arg Term) -> MaybeReduced (Arg Term))
-> (Term -> Blocked (Arg Term)) -> Term -> MaybeReduced (Arg Term)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Arg Term -> Blocked (Arg Term)
forall a t. a -> Blocked' t a
notBlocked (Arg Term -> Blocked (Arg Term))
-> (Term -> Arg Term) -> Term -> Blocked (Arg Term)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term -> Arg Term
forall e. e -> Arg e
argN) (ReduceM Term -> ReduceM (MaybeReduced (Arg Term)))
-> (NamesT ReduceM Term -> ReduceM Term)
-> NamesT ReduceM Term
-> ReduceM (MaybeReduced (Arg Term))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Names -> NamesT ReduceM Term -> ReduceM Term
forall (m :: * -> *) a. Names -> NamesT m a -> m a
runNamesT [] (NamesT ReduceM Term -> ReduceM (MaybeReduced (Arg Term)))
-> NamesT ReduceM Term -> ReduceM (MaybeReduced (Arg Term))
forall a b. (a -> b) -> a -> b
$ do
                                            [NamesT ReduceM Term
l,NamesT ReduceM Term
c] <- (Arg Term -> NamesT ReduceM (NamesT ReduceM Term))
-> [Arg Term] -> NamesT ReduceM [NamesT ReduceM Term]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Term -> NamesT ReduceM (NamesT ReduceM Term)
forall (m :: * -> *) a.
(MonadFail m, Subst a) =>
a -> NamesT m (NamesT m a)
open (Term -> NamesT ReduceM (NamesT ReduceM Term))
-> (Arg Term -> Term)
-> Arg Term
-> NamesT ReduceM (NamesT ReduceM Term)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Arg Term -> Term
forall e. Arg e -> e
unArg) [FamilyOrNot (Arg Term) -> Arg Term
forall a. FamilyOrNot a -> a
famThing FamilyOrNot (Arg Term)
l, Blocked (Arg Term) -> Arg Term
forall t a. Blocked' t a -> a
ignoreBlocking Blocked (Arg Term)
sc]
                                            String
-> (NamesT ReduceM Term -> NamesT ReduceM Term)
-> NamesT ReduceM Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
lam String
"i" ((NamesT ReduceM Term -> NamesT ReduceM Term)
 -> NamesT ReduceM Term)
-> (NamesT ReduceM Term -> NamesT ReduceM Term)
-> NamesT ReduceM Term
forall a b. (a -> b) -> a -> b
$ \ NamesT ReduceM Term
i -> String -> NamesT ReduceM Term
clP String
builtinIsOneEmpty NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> NamesT ReduceM Term
l
                                                                   NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> String
-> (NamesT ReduceM Term -> NamesT ReduceM Term)
-> NamesT ReduceM Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
ilam String
"o" (\ NamesT ReduceM Term
_ -> NamesT ReduceM Term
c)
                                          IntervalView
_     -> MaybeReduced (Arg Term) -> ReduceM (MaybeReduced (Arg Term))
forall (m :: * -> *) a. Monad m => a -> m a
return (Arg Term -> MaybeReduced (Arg Term)
forall a. a -> MaybeReduced a
notReduced Arg Term
u)
                            -- cmd == DoTransp
                     Maybe (Arg Term)
Nothing -> MaybeReducedArgs -> ReduceM MaybeReducedArgs
forall (m :: * -> *) a. Monad m => a -> m a
return []
             Reduced MaybeReducedArgs Term
-> ReduceM (Reduced MaybeReducedArgs Term)
forall (m :: * -> *) a. Monad m => a -> m a
return (Reduced MaybeReducedArgs Term
 -> ReduceM (Reduced MaybeReducedArgs Term))
-> Reduced MaybeReducedArgs Term
-> ReduceM (Reduced MaybeReducedArgs Term)
forall a b. (a -> b) -> a -> b
$ MaybeReducedArgs -> Reduced MaybeReducedArgs Term
forall no yes. no -> Reduced no yes
NoReduction (MaybeReducedArgs -> Reduced MaybeReducedArgs Term)
-> MaybeReducedArgs -> Reduced MaybeReducedArgs Term
forall a b. (a -> b) -> a -> b
$ [Arg Term -> MaybeReduced (Arg Term)
forall a. a -> MaybeReduced a
notReduced (FamilyOrNot (Arg Term) -> Arg Term
forall a. FamilyOrNot a -> a
famThing FamilyOrNot (Arg Term)
l), Blocked (Arg Term) -> MaybeReduced (Arg Term)
reduced Blocked (Arg Term)
sc, Blocked (Arg Term) -> MaybeReduced (Arg Term)
reduced Blocked (Arg Term)
sphi] MaybeReducedArgs -> MaybeReducedArgs -> MaybeReducedArgs
forall a. [a] -> [a] -> [a]
++ MaybeReducedArgs
u' MaybeReducedArgs -> MaybeReducedArgs -> MaybeReducedArgs
forall a. [a] -> [a] -> [a]
++ [Arg Term -> MaybeReduced (Arg Term)
forall a. a -> MaybeReduced a
notReduced Arg Term
u0]
       Blocked (FamilyOrNot (Arg Term))
sbA <- FamilyOrNot (Arg Term)
-> ReduceM (Blocked (FamilyOrNot (Arg Term)))
forall t. Reduce t => t -> ReduceM (Blocked t)
reduceB' FamilyOrNot (Arg Term)
bA
       Maybe (Blocked' Term (FamilyOrNot Term))
t <- case Arg Term -> Term
forall e. Arg e -> e
unArg (Arg Term -> Term) -> FamilyOrNot (Arg Term) -> FamilyOrNot Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Blocked (FamilyOrNot (Arg Term)) -> FamilyOrNot (Arg Term)
forall t a. Blocked' t a -> a
ignoreBlocking Blocked (FamilyOrNot (Arg Term))
sbA of
              IsFam (Lam ArgInfo
_info Abs Term
t) -> Blocked' Term (FamilyOrNot Term)
-> Maybe (Blocked' Term (FamilyOrNot Term))
forall a. a -> Maybe a
Just (Blocked' Term (FamilyOrNot Term)
 -> Maybe (Blocked' Term (FamilyOrNot Term)))
-> (Blocked' Term Term -> Blocked' Term (FamilyOrNot Term))
-> Blocked' Term Term
-> Maybe (Blocked' Term (FamilyOrNot Term))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Term -> FamilyOrNot Term)
-> Blocked' Term Term -> Blocked' Term (FamilyOrNot Term)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Term -> FamilyOrNot Term
forall a. a -> FamilyOrNot a
IsFam (Blocked' Term Term -> Maybe (Blocked' Term (FamilyOrNot Term)))
-> ReduceM (Blocked' Term Term)
-> ReduceM (Maybe (Blocked' Term (FamilyOrNot Term)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term -> ReduceM (Blocked' Term Term)
forall t. Reduce t => t -> ReduceM (Blocked t)
reduceB' (Abs Term -> Term
forall a. Subst a => Abs a -> a
absBody Abs Term
t)
              IsFam Term
_             -> Maybe (Blocked' Term (FamilyOrNot Term))
-> ReduceM (Maybe (Blocked' Term (FamilyOrNot Term)))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Blocked' Term (FamilyOrNot Term))
forall a. Maybe a
Nothing
              IsNot Term
t             -> Maybe (Blocked' Term (FamilyOrNot Term))
-> ReduceM (Maybe (Blocked' Term (FamilyOrNot Term)))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Blocked' Term (FamilyOrNot Term))
 -> ReduceM (Maybe (Blocked' Term (FamilyOrNot Term))))
-> (Blocked' Term Term -> Maybe (Blocked' Term (FamilyOrNot Term)))
-> Blocked' Term Term
-> ReduceM (Maybe (Blocked' Term (FamilyOrNot Term)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Blocked' Term (FamilyOrNot Term)
-> Maybe (Blocked' Term (FamilyOrNot Term))
forall a. a -> Maybe a
Just (Blocked' Term (FamilyOrNot Term)
 -> Maybe (Blocked' Term (FamilyOrNot Term)))
-> (Blocked' Term Term -> Blocked' Term (FamilyOrNot Term))
-> Blocked' Term Term
-> Maybe (Blocked' Term (FamilyOrNot Term))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Term -> FamilyOrNot Term)
-> Blocked' Term Term -> Blocked' Term (FamilyOrNot Term)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Term -> FamilyOrNot Term
forall a. a -> FamilyOrNot a
IsNot (Blocked' Term Term
 -> ReduceM (Maybe (Blocked' Term (FamilyOrNot Term))))
-> Blocked' Term Term
-> ReduceM (Maybe (Blocked' Term (FamilyOrNot Term)))
forall a b. (a -> b) -> a -> b
$ (Term
t Term -> Blocked (FamilyOrNot (Arg Term)) -> Blocked' Term Term
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Blocked (FamilyOrNot (Arg Term))
sbA)
       case Maybe (Blocked' Term (FamilyOrNot Term))
t of
         Maybe (Blocked' Term (FamilyOrNot Term))
Nothing -> Blocked (Arg Term) -> ReduceM (Reduced MaybeReducedArgs Term)
fallback' (FamilyOrNot (Arg Term) -> Arg Term
forall a. FamilyOrNot a -> a
famThing (FamilyOrNot (Arg Term) -> Arg Term)
-> Blocked (FamilyOrNot (Arg Term)) -> Blocked (Arg Term)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Blocked (FamilyOrNot (Arg Term))
sbA)
         Just Blocked' Term (FamilyOrNot Term)
st  -> do
               let
                   fallback :: ReduceM (Reduced MaybeReducedArgs Term)
fallback = Blocked (Arg Term) -> ReduceM (Reduced MaybeReducedArgs Term)
fallback' ((FamilyOrNot (Arg Term) -> Arg Term)
-> Blocked (FamilyOrNot (Arg Term)) -> Blocked (Arg Term)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FamilyOrNot (Arg Term) -> Arg Term
forall a. FamilyOrNot a -> a
famThing (Blocked (FamilyOrNot (Arg Term)) -> Blocked (Arg Term))
-> Blocked (FamilyOrNot (Arg Term)) -> Blocked (Arg Term)
forall a b. (a -> b) -> a -> b
$ Blocked' Term (FamilyOrNot Term)
st Blocked' Term (FamilyOrNot Term)
-> Blocked (FamilyOrNot (Arg Term))
-> Blocked (FamilyOrNot (Arg Term))
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Blocked (FamilyOrNot (Arg Term))
sbA)
                   t :: FamilyOrNot Term
t = Blocked' Term (FamilyOrNot Term) -> FamilyOrNot Term
forall t a. Blocked' t a -> a
ignoreBlocking Blocked' Term (FamilyOrNot Term)
st
               Maybe QName
mHComp <- String -> ReduceM (Maybe QName)
forall (m :: * -> *). HasBuiltins m => String -> m (Maybe QName)
getPrimitiveName' String
builtinHComp
               Maybe QName
mGlue <- String -> ReduceM (Maybe QName)
forall (m :: * -> *). HasBuiltins m => String -> m (Maybe QName)
getPrimitiveName' String
builtinGlue
               Maybe QName
mId   <- String -> ReduceM (Maybe QName)
forall (m :: * -> *). HasBuiltins m => String -> m (Maybe QName)
getBuiltinName' String
builtinId
               Type -> PathView
pathV <- ReduceM (Type -> PathView)
forall (m :: * -> *). HasBuiltins m => m (Type -> PathView)
pathView'
               case FamilyOrNot Term -> Term
forall a. FamilyOrNot a -> a
famThing FamilyOrNot Term
t of
                 MetaV MetaId
m [Elim]
_ -> Blocked (Arg Term) -> ReduceM (Reduced MaybeReducedArgs Term)
fallback' ((FamilyOrNot (Arg Term) -> Arg Term)
-> Blocked (FamilyOrNot (Arg Term)) -> Blocked (Arg Term)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FamilyOrNot (Arg Term) -> Arg Term
forall a. FamilyOrNot a -> a
famThing (Blocked (FamilyOrNot (Arg Term)) -> Blocked (Arg Term))
-> Blocked (FamilyOrNot (Arg Term)) -> Blocked (Arg Term)
forall a b. (a -> b) -> a -> b
$ MetaId -> Blocked' Term ()
forall t. MetaId -> Blocked' t ()
blocked_ MetaId
m Blocked' Term ()
-> Blocked (FamilyOrNot (Arg Term))
-> Blocked (FamilyOrNot (Arg Term))
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Blocked (FamilyOrNot (Arg Term))
sbA)
                 -- absName t instead of "i"
                 Pi Dom Type
a Abs Type
b | Arity
nelims Arity -> Arity -> Bool
forall a. Ord a => a -> a -> Bool
> Arity
0  -> ReduceM (Reduced MaybeReducedArgs Term)
-> (Term -> ReduceM (Reduced MaybeReducedArgs Term))
-> Maybe Term
-> ReduceM (Reduced MaybeReducedArgs Term)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ReduceM (Reduced MaybeReducedArgs Term)
fallback Term -> ReduceM (Reduced MaybeReducedArgs Term)
forall a a'. a -> ReduceM (Reduced a' a)
redReturn (Maybe Term -> ReduceM (Reduced MaybeReducedArgs Term))
-> ReduceM (Maybe Term) -> ReduceM (Reduced MaybeReducedArgs Term)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< TranspOrHComp
-> String
-> FamilyOrNot (Dom Type, Abs Type)
-> Arg Term
-> Maybe (Arg Term)
-> Arg Term
-> ReduceM (Maybe Term)
compPi TranspOrHComp
cmd String
"i" ((Dom Type
a,Abs Type
b) (Dom Type, Abs Type)
-> FamilyOrNot Term -> FamilyOrNot (Dom Type, Abs Type)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ FamilyOrNot Term
t) (Blocked (Arg Term) -> Arg Term
forall t a. Blocked' t a -> a
ignoreBlocking Blocked (Arg Term)
sphi) Maybe (Arg Term)
u Arg Term
u0
                        | Bool
otherwise -> ReduceM (Reduced MaybeReducedArgs Term)
fallback

                 Sort (Type Level' Term
l) | TranspOrHComp
DoTransp <- TranspOrHComp
cmd -> TranspOrHComp
-> ReduceM (Reduced MaybeReducedArgs Term)
-> Arg Term
-> Maybe (Arg Term)
-> Arg Term
-> FamilyOrNot (Level' Term)
-> ReduceM (Reduced MaybeReducedArgs Term)
forall p p a a a a'.
TranspOrHComp
-> p
-> p
-> Maybe a
-> Arg a
-> FamilyOrNot a
-> ReduceM (Reduced a' a)
compSort TranspOrHComp
cmd ReduceM (Reduced MaybeReducedArgs Term)
fallback Arg Term
phi Maybe (Arg Term)
u Arg Term
u0 (Level' Term
l Level' Term -> FamilyOrNot Term -> FamilyOrNot (Level' Term)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ FamilyOrNot Term
t)

                 Def QName
q [Apply Arg Term
la, Apply Arg Term
lb, Apply Arg Term
bA, Apply Arg Term
phi', Apply Arg Term
bT, Apply Arg Term
e] | QName -> Maybe QName
forall a. a -> Maybe a
Just QName
q Maybe QName -> Maybe QName -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe QName
mGlue -> do
                   ReduceM (Reduced MaybeReducedArgs Term)
-> (Term -> ReduceM (Reduced MaybeReducedArgs Term))
-> Maybe Term
-> ReduceM (Reduced MaybeReducedArgs Term)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ReduceM (Reduced MaybeReducedArgs Term)
fallback Term -> ReduceM (Reduced MaybeReducedArgs Term)
forall a a'. a -> ReduceM (Reduced a' a)
redReturn (Maybe Term -> ReduceM (Reduced MaybeReducedArgs Term))
-> ReduceM (Maybe Term) -> ReduceM (Reduced MaybeReducedArgs Term)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< TranspOrHComp
-> Arg Term
-> Maybe (Arg Term)
-> Arg Term
-> FamilyOrNot
     (Arg Term, Arg Term, Arg Term, Arg Term, Arg Term, Arg Term)
-> TermPosition
-> ReduceM (Maybe Term)
forall (m :: * -> *).
PureTCM m =>
TranspOrHComp
-> Arg Term
-> Maybe (Arg Term)
-> Arg Term
-> FamilyOrNot
     (Arg Term, Arg Term, Arg Term, Arg Term, Arg Term, Arg Term)
-> TermPosition
-> m (Maybe Term)
compGlue TranspOrHComp
cmd Arg Term
phi Maybe (Arg Term)
u Arg Term
u0 ((Arg Term
la, Arg Term
lb, Arg Term
bA, Arg Term
phi', Arg Term
bT, Arg Term
e) (Arg Term, Arg Term, Arg Term, Arg Term, Arg Term, Arg Term)
-> FamilyOrNot Term
-> FamilyOrNot
     (Arg Term, Arg Term, Arg Term, Arg Term, Arg Term, Arg Term)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ FamilyOrNot Term
t) TermPosition
Head

                 Def QName
q [Apply Arg Term
_, Apply Arg Term
s, Apply Arg Term
phi', Apply Arg Term
bT, Apply Arg Term
bA]
                   | QName -> Maybe QName
forall a. a -> Maybe a
Just QName
q Maybe QName -> Maybe QName -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe QName
mHComp, Sort (Type Level' Term
la) <- Arg Term -> Term
forall e. Arg e -> e
unArg Arg Term
s  -> do
                   ReduceM (Reduced MaybeReducedArgs Term)
-> (Term -> ReduceM (Reduced MaybeReducedArgs Term))
-> Maybe Term
-> ReduceM (Reduced MaybeReducedArgs Term)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ReduceM (Reduced MaybeReducedArgs Term)
fallback Term -> ReduceM (Reduced MaybeReducedArgs Term)
forall a a'. a -> ReduceM (Reduced a' a)
redReturn (Maybe Term -> ReduceM (Reduced MaybeReducedArgs Term))
-> ReduceM (Maybe Term) -> ReduceM (Reduced MaybeReducedArgs Term)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< TranspOrHComp
-> Arg Term
-> Maybe (Arg Term)
-> Arg Term
-> FamilyOrNot (Arg Term, Arg Term, Arg Term, Arg Term)
-> TermPosition
-> ReduceM (Maybe Term)
forall (m :: * -> *).
PureTCM m =>
TranspOrHComp
-> Arg Term
-> Maybe (Arg Term)
-> Arg Term
-> FamilyOrNot (Arg Term, Arg Term, Arg Term, Arg Term)
-> TermPosition
-> m (Maybe Term)
compHCompU TranspOrHComp
cmd Arg Term
phi Maybe (Arg Term)
u Arg Term
u0 ((Level' Term -> Term
Level Level' Term
la Term -> Arg Term -> Arg Term
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Arg Term
s, Arg Term
phi', Arg Term
bT, Arg Term
bA) (Arg Term, Arg Term, Arg Term, Arg Term)
-> FamilyOrNot Term
-> FamilyOrNot (Arg Term, Arg Term, Arg Term, Arg Term)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ FamilyOrNot Term
t) TermPosition
Head

                 -- Path/PathP
                 Term
d | PathType Sort' Term
_ QName
_ Arg Term
_ Arg Term
bA Arg Term
x Arg Term
y <- Type -> PathView
pathV (Sort' Term -> Term -> Type
forall t a. Sort' t -> a -> Type'' t a
El Sort' Term
HasCallStack => Sort' Term
__DUMMY_SORT__ Term
d) -> do
                   if Arity
nelims Arity -> Arity -> Bool
forall a. Ord a => a -> a -> Bool
> Arity
0 then TranspOrHComp
-> Blocked (Arg Term)
-> Maybe (Arg Term)
-> Arg Term
-> FamilyOrNot (Arg Term)
-> FamilyOrNot (Arg Term, Arg Term, Arg Term)
-> ReduceM (Reduced MaybeReducedArgs Term)
forall t a'.
TranspOrHComp
-> Blocked' t (Arg Term)
-> Maybe (Arg Term)
-> Arg Term
-> FamilyOrNot (Arg Term)
-> FamilyOrNot (Arg Term, Arg Term, Arg Term)
-> ReduceM (Reduced a' Term)
compPathP TranspOrHComp
cmd Blocked (Arg Term)
sphi Maybe (Arg Term)
u Arg Term
u0 FamilyOrNot (Arg Term)
l ((Arg Term
bA, Arg Term
x, Arg Term
y) (Arg Term, Arg Term, Arg Term)
-> FamilyOrNot Term -> FamilyOrNot (Arg Term, Arg Term, Arg Term)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ FamilyOrNot Term
t) else ReduceM (Reduced MaybeReducedArgs Term)
fallback

                 Def QName
q [Apply Arg Term
_ , Apply Arg Term
bA , Apply Arg Term
x , Apply Arg Term
y] | QName -> Maybe QName
forall a. a -> Maybe a
Just QName
q Maybe QName -> Maybe QName -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe QName
mId -> do
                   ReduceM (Reduced MaybeReducedArgs Term)
-> (Reduced MaybeReducedArgs Term
    -> ReduceM (Reduced MaybeReducedArgs Term))
-> Maybe (Reduced MaybeReducedArgs Term)
-> ReduceM (Reduced MaybeReducedArgs Term)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ReduceM (Reduced MaybeReducedArgs Term)
fallback Reduced MaybeReducedArgs Term
-> ReduceM (Reduced MaybeReducedArgs Term)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Reduced MaybeReducedArgs Term)
 -> ReduceM (Reduced MaybeReducedArgs Term))
-> ReduceM (Maybe (Reduced MaybeReducedArgs Term))
-> ReduceM (Reduced MaybeReducedArgs Term)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< TranspOrHComp
-> Blocked (Arg Term)
-> Maybe (Arg Term)
-> Arg Term
-> FamilyOrNot (Arg Term)
-> FamilyOrNot (Arg Term, Arg Term, Arg Term)
-> ReduceM (Maybe (Reduced MaybeReducedArgs Term))
forall t a'.
TranspOrHComp
-> Blocked' t (Arg Term)
-> Maybe (Arg Term)
-> Arg Term
-> FamilyOrNot (Arg Term)
-> FamilyOrNot (Arg Term, Arg Term, Arg Term)
-> ReduceM (Maybe (Reduced a' Term))
compId TranspOrHComp
cmd Blocked (Arg Term)
sphi Maybe (Arg Term)
u Arg Term
u0 FamilyOrNot (Arg Term)
l ((Arg Term
bA, Arg Term
x, Arg Term
y) (Arg Term, Arg Term, Arg Term)
-> FamilyOrNot Term -> FamilyOrNot (Arg Term, Arg Term, Arg Term)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ FamilyOrNot Term
t)

                 Def QName
q [Elim]
es -> do
                   Definition
info <- QName -> ReduceM Definition
forall (m :: * -> *). HasConstInfo m => QName -> m Definition
getConstInfo QName
q
                   let   lam_i :: Term -> Term
lam_i = ArgInfo -> Abs Term -> Term
Lam ArgInfo
defaultArgInfo (Abs Term -> Term) -> (Term -> Abs Term) -> Term -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Term -> Abs Term
forall a. String -> a -> Abs a
Abs String
"i"

                   case Definition -> Defn
theDef Definition
info of
                     r :: Defn
r@Record{recComp :: Defn -> CompKit
recComp = CompKit
kit} | Arity
nelims Arity -> Arity -> Bool
forall a. Ord a => a -> a -> Bool
> Arity
0, Just [Arg Term]
as <- [Elim] -> Maybe [Arg Term]
forall a. [Elim' a] -> Maybe [Arg a]
allApplyElims [Elim]
es, TranspOrHComp
DoTransp <- TranspOrHComp
cmd, Just QName
transpR <- CompKit -> Maybe QName
nameOfTransp CompKit
kit
                                -> if Defn -> Arity
recPars Defn
r Arity -> Arity -> Bool
forall a. Eq a => a -> a -> Bool
== Arity
0
                                   then Term -> ReduceM (Reduced MaybeReducedArgs Term)
forall a a'. a -> ReduceM (Reduced a' a)
redReturn (Term -> ReduceM (Reduced MaybeReducedArgs Term))
-> Term -> ReduceM (Reduced MaybeReducedArgs Term)
forall a b. (a -> b) -> a -> b
$ Arg Term -> Term
forall e. Arg e -> e
unArg Arg Term
u0
                                   else Term -> ReduceM (Reduced MaybeReducedArgs Term)
forall a a'. a -> ReduceM (Reduced a' a)
redReturn (Term -> ReduceM (Reduced MaybeReducedArgs Term))
-> Term -> ReduceM (Reduced MaybeReducedArgs Term)
forall a b. (a -> b) -> a -> b
$ (QName -> [Elim] -> Term
Def QName
transpR []) Term -> [Arg Term] -> Term
forall t. Apply t => t -> [Arg Term] -> t
`apply`
                                               ((Arg Term -> Arg Term) -> [Arg Term] -> [Arg Term]
forall a b. (a -> b) -> [a] -> [b]
map ((Term -> Term) -> Arg Term -> Arg Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Term -> Term
lam_i) [Arg Term]
as [Arg Term] -> [Arg Term] -> [Arg Term]
forall a. [a] -> [a] -> [a]
++ [Blocked (Arg Term) -> Arg Term
forall t a. Blocked' t a -> a
ignoreBlocking Blocked (Arg Term)
sphi,Arg Term
u0])
                         | Arity
nelims Arity -> Arity -> Bool
forall a. Ord a => a -> a -> Bool
> Arity
0, Just [Arg Term]
as <- [Elim] -> Maybe [Arg Term]
forall a. [Elim' a] -> Maybe [Arg a]
allApplyElims [Elim]
es, TranspOrHComp
DoHComp <- TranspOrHComp
cmd, Just QName
hCompR <- CompKit -> Maybe QName
nameOfHComp CompKit
kit
                                -> Term -> ReduceM (Reduced MaybeReducedArgs Term)
forall a a'. a -> ReduceM (Reduced a' a)
redReturn (Term -> ReduceM (Reduced MaybeReducedArgs Term))
-> Term -> ReduceM (Reduced MaybeReducedArgs Term)
forall a b. (a -> b) -> a -> b
$ (QName -> [Elim] -> Term
Def QName
hCompR []) Term -> [Arg Term] -> Term
forall t. Apply t => t -> [Arg Term] -> t
`apply`
                                               ([Arg Term]
as [Arg Term] -> [Arg Term] -> [Arg Term]
forall a. [a] -> [a] -> [a]
++ [Blocked (Arg Term) -> Arg Term
forall t a. Blocked' t a -> a
ignoreBlocking Blocked (Arg Term)
sphi,Arg Term -> Maybe (Arg Term) -> Arg Term
forall a. a -> Maybe a -> a
fromMaybe Arg Term
forall a. HasCallStack => a
__IMPOSSIBLE__ Maybe (Arg Term)
u,Arg Term
u0])

                         | Just [Arg Term]
as <- [Elim] -> Maybe [Arg Term]
forall a. [Elim' a] -> Maybe [Arg a]
allApplyElims [Elim]
es, [] <- Defn -> [Dom QName]
recFields Defn
r -> Bool
-> Arity
-> TranspOrHComp
-> FamilyOrNot (Arg Term)
-> FamilyOrNot [Arg Term]
-> Blocked (FamilyOrNot (Arg Term))
-> Blocked (Arg Term)
-> Maybe (Arg Term)
-> Arg Term
-> ReduceM (Reduced MaybeReducedArgs Term)
forall a.
(Eq a, Num a) =>
Bool
-> a
-> TranspOrHComp
-> FamilyOrNot (Arg Term)
-> FamilyOrNot [Arg Term]
-> Blocked (FamilyOrNot (Arg Term))
-> Blocked (Arg Term)
-> Maybe (Arg Term)
-> Arg Term
-> ReduceM (Reduced MaybeReducedArgs Term)
compData Bool
False (Defn -> Arity
recPars Defn
r) TranspOrHComp
cmd FamilyOrNot (Arg Term)
l ([Arg Term]
as [Arg Term] -> FamilyOrNot Term -> FamilyOrNot [Arg Term]
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ FamilyOrNot Term
t) Blocked (FamilyOrNot (Arg Term))
sbA Blocked (Arg Term)
sphi Maybe (Arg Term)
u Arg Term
u0
                     Datatype{dataPars :: Defn -> Arity
dataPars = Arity
pars, dataIxs :: Defn -> Arity
dataIxs = Arity
ixs, dataPathCons :: Defn -> [QName]
dataPathCons = [QName]
pcons}
                       | [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and [[QName] -> Bool
forall a. Null a => a -> Bool
null [QName]
pcons | TranspOrHComp
DoHComp  <- [TranspOrHComp
cmd]], Just [Arg Term]
as <- [Elim] -> Maybe [Arg Term]
forall a. [Elim' a] -> Maybe [Arg a]
allApplyElims [Elim]
es -> Bool
-> Arity
-> TranspOrHComp
-> FamilyOrNot (Arg Term)
-> FamilyOrNot [Arg Term]
-> Blocked (FamilyOrNot (Arg Term))
-> Blocked (Arg Term)
-> Maybe (Arg Term)
-> Arg Term
-> ReduceM (Reduced MaybeReducedArgs Term)
forall a.
(Eq a, Num a) =>
Bool
-> a
-> TranspOrHComp
-> FamilyOrNot (Arg Term)
-> FamilyOrNot [Arg Term]
-> Blocked (FamilyOrNot (Arg Term))
-> Blocked (Arg Term)
-> Maybe (Arg Term)
-> Arg Term
-> ReduceM (Reduced MaybeReducedArgs Term)
compData (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [QName] -> Bool
forall a. Null a => a -> Bool
null ([QName] -> Bool) -> [QName] -> Bool
forall a b. (a -> b) -> a -> b
$ [QName]
pcons) (Arity
parsArity -> Arity -> Arity
forall a. Num a => a -> a -> a
+Arity
ixs) TranspOrHComp
cmd FamilyOrNot (Arg Term)
l ([Arg Term]
as [Arg Term] -> FamilyOrNot Term -> FamilyOrNot [Arg Term]
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ FamilyOrNot Term
t) Blocked (FamilyOrNot (Arg Term))
sbA Blocked (Arg Term)
sphi Maybe (Arg Term)
u Arg Term
u0
                     Axiom Bool
constTransp | Bool
constTransp, [] <- [Elim]
es, TranspOrHComp
DoTransp <- TranspOrHComp
cmd -> Term -> ReduceM (Reduced MaybeReducedArgs Term)
forall a a'. a -> ReduceM (Reduced a' a)
redReturn (Term -> ReduceM (Reduced MaybeReducedArgs Term))
-> Term -> ReduceM (Reduced MaybeReducedArgs Term)
forall a b. (a -> b) -> a -> b
$ Arg Term -> Term
forall e. Arg e -> e
unArg Arg Term
u0
                     Defn
_          -> ReduceM (Reduced MaybeReducedArgs Term)
fallback

                 Term
_ -> ReduceM (Reduced MaybeReducedArgs Term)
fallback
  where
    compSort :: TranspOrHComp
-> p
-> p
-> Maybe a
-> Arg a
-> FamilyOrNot a
-> ReduceM (Reduced a' a)
compSort TranspOrHComp
DoTransp p
fallback p
phi Maybe a
Nothing Arg a
u0 (IsFam a
l) = do
      -- TODO should check l is constant
      a -> ReduceM (Reduced a' a)
forall a a'. a -> ReduceM (Reduced a' a)
redReturn (a -> ReduceM (Reduced a' a)) -> a -> ReduceM (Reduced a' a)
forall a b. (a -> b) -> a -> b
$ Arg a -> a
forall e. Arg e -> e
unArg Arg a
u0
    -- compSort DoHComp fallback phi (Just u) u0 (IsNot l) = -- hcomp for Set is a whnf, handled above.
    compSort TranspOrHComp
_ p
fallback p
phi Maybe a
u Arg a
u0 FamilyOrNot a
_ = ReduceM (Reduced a' a)
forall a. HasCallStack => a
__IMPOSSIBLE__
    compPi :: TranspOrHComp -> ArgName -> FamilyOrNot (Dom Type, Abs Type) -- Γ , i : I
            -> Arg Term -- Γ
            -> Maybe (Arg Term) -- Γ
            -> Arg Term -- Γ
            -> ReduceM (Maybe Term)
    compPi :: TranspOrHComp
-> String
-> FamilyOrNot (Dom Type, Abs Type)
-> Arg Term
-> Maybe (Arg Term)
-> Arg Term
-> ReduceM (Maybe Term)
compPi TranspOrHComp
cmd String
t FamilyOrNot (Dom Type, Abs Type)
ab Arg Term
phi Maybe (Arg Term)
u Arg Term
u0 = do
     let getTermLocal :: String -> ReduceM Term
getTermLocal = String -> String -> ReduceM Term
forall (m :: * -> *). HasBuiltins m => String -> String -> m Term
getTerm (String -> String -> ReduceM Term)
-> String -> String -> ReduceM Term
forall a b. (a -> b) -> a -> b
$ TranspOrHComp -> String
cmdToName TranspOrHComp
cmd String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" for function types"

     Term
tTrans <- String -> ReduceM Term
getTermLocal String
builtinTrans
     Term
tHComp <- String -> ReduceM Term
getTermLocal String
builtinHComp
     Term
tINeg <- String -> ReduceM Term
getTermLocal String
builtinINeg
     Term
tIMax <- String -> ReduceM Term
getTermLocal String
builtinIMax
     Term
iz    <- String -> ReduceM Term
getTermLocal String
builtinIZero
     let
      toLevel' :: a -> m (Maybe (Level' Term))
toLevel' a
t = do
        Sort' Term
s <- Sort' Term -> m (Sort' Term)
forall a (m :: * -> *). (Reduce a, MonadReduce m) => a -> m a
reduce (Sort' Term -> m (Sort' Term)) -> Sort' Term -> m (Sort' Term)
forall a b. (a -> b) -> a -> b
$ a -> Sort' Term
forall a. LensSort a => a -> Sort' Term
getSort a
t
        case Sort' Term
s of
          (Type Level' Term
l) -> Maybe (Level' Term) -> m (Maybe (Level' Term))
forall (m :: * -> *) a. Monad m => a -> m a
return (Level' Term -> Maybe (Level' Term)
forall a. a -> Maybe a
Just Level' Term
l)
          Sort' Term
_        -> Maybe (Level' Term) -> m (Maybe (Level' Term))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Level' Term)
forall a. Maybe a
Nothing
      toLevel :: a -> f (Level' Term)
toLevel a
t = Level' Term -> Maybe (Level' Term) -> Level' Term
forall a. a -> Maybe a -> a
fromMaybe Level' Term
forall a. HasCallStack => a
__IMPOSSIBLE__ (Maybe (Level' Term) -> Level' Term)
-> f (Maybe (Level' Term)) -> f (Level' Term)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f (Maybe (Level' Term))
forall (m :: * -> *) a.
(MonadReduce m, LensSort a) =>
a -> m (Maybe (Level' Term))
toLevel' a
t
     -- make sure the codomain has a level.
     ReduceM (Maybe (Level' Term))
-> ReduceM (Maybe Term)
-> (Level' Term -> ReduceM (Maybe Term))
-> ReduceM (Maybe Term)
forall (m :: * -> *) a b.
Monad m =>
m (Maybe a) -> m b -> (a -> m b) -> m b
caseMaybeM (Type -> ReduceM (Maybe (Level' Term))
forall (m :: * -> *) a.
(MonadReduce m, LensSort a) =>
a -> m (Maybe (Level' Term))
toLevel' (Type -> ReduceM (Maybe (Level' Term)))
-> (FamilyOrNot (Dom Type, Abs Type) -> Type)
-> FamilyOrNot (Dom Type, Abs Type)
-> ReduceM (Maybe (Level' Term))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Abs Type -> Type
forall a. Subst a => Abs a -> a
absBody (Abs Type -> Type)
-> (FamilyOrNot (Dom Type, Abs Type) -> Abs Type)
-> FamilyOrNot (Dom Type, Abs Type)
-> Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Dom Type, Abs Type) -> Abs Type
forall a b. (a, b) -> b
snd ((Dom Type, Abs Type) -> Abs Type)
-> (FamilyOrNot (Dom Type, Abs Type) -> (Dom Type, Abs Type))
-> FamilyOrNot (Dom Type, Abs Type)
-> Abs Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FamilyOrNot (Dom Type, Abs Type) -> (Dom Type, Abs Type)
forall a. FamilyOrNot a -> a
famThing (FamilyOrNot (Dom Type, Abs Type) -> ReduceM (Maybe (Level' Term)))
-> FamilyOrNot (Dom Type, Abs Type)
-> ReduceM (Maybe (Level' Term))
forall a b. (a -> b) -> a -> b
$ FamilyOrNot (Dom Type, Abs Type)
ab) (Maybe Term -> ReduceM (Maybe Term)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Term
forall a. Maybe a
Nothing) ((Level' Term -> ReduceM (Maybe Term)) -> ReduceM (Maybe Term))
-> (Level' Term -> ReduceM (Maybe Term)) -> ReduceM (Maybe Term)
forall a b. (a -> b) -> a -> b
$ \ Level' Term
_ -> do
     Names -> NamesT ReduceM (Maybe Term) -> ReduceM (Maybe Term)
forall (m :: * -> *) a. Names -> NamesT m a -> m a
runNamesT [] (NamesT ReduceM (Maybe Term) -> ReduceM (Maybe Term))
-> NamesT ReduceM (Maybe Term) -> ReduceM (Maybe Term)
forall a b. (a -> b) -> a -> b
$ do
      Maybe
  ((NamesT ReduceM Term -> NamesT ReduceM Term)
   -> NamesT ReduceM Term
   -> NamesT ReduceM Term
   -> NamesT ReduceM Term)
labA <- do
        let (Dom Type
x,Term -> Term
f) = case FamilyOrNot (Dom Type, Abs Type)
ab of
              IsFam (Dom Type
a,Abs Type
_) -> (Dom Type
a, \ Term
a -> Names -> NamesT Fail Term -> Term
forall a. Names -> NamesT Fail a -> a
runNames [] (NamesT Fail Term -> Term) -> NamesT Fail Term -> Term
forall a b. (a -> b) -> a -> b
$ String
-> (NamesT Fail Term -> NamesT Fail Term) -> NamesT Fail Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
lam String
"i" (NamesT Fail Term -> NamesT Fail Term -> NamesT Fail Term
forall a b. a -> b -> a
const (Term -> NamesT Fail Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
a)))
              IsNot (Dom Type
a,Abs Type
_) -> (Dom Type
a, Term -> Term
forall a. a -> a
id)
        Sort' Term
s <- Sort' Term -> NamesT ReduceM (Sort' Term)
forall a (m :: * -> *). (Reduce a, MonadReduce m) => a -> m a
reduce (Sort' Term -> NamesT ReduceM (Sort' Term))
-> Sort' Term -> NamesT ReduceM (Sort' Term)
forall a b. (a -> b) -> a -> b
$ Dom Type -> Sort' Term
forall a. LensSort a => a -> Sort' Term
getSort Dom Type
x
        case Sort' Term
s of
          Type Level' Term
lx -> do
            [NamesT ReduceM Term
la,NamesT ReduceM Term
bA] <- (Term -> NamesT ReduceM (NamesT ReduceM Term))
-> [Term] -> NamesT ReduceM [NamesT ReduceM Term]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Term -> NamesT ReduceM (NamesT ReduceM Term)
forall (m :: * -> *) a.
(MonadFail m, Subst a) =>
a -> NamesT m (NamesT m a)
open (Term -> NamesT ReduceM (NamesT ReduceM Term))
-> (Term -> Term) -> Term -> NamesT ReduceM (NamesT ReduceM Term)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term -> Term
f) [Level' Term -> Term
Level Level' Term
lx, 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
x]
            Maybe
  ((NamesT ReduceM Term -> NamesT ReduceM Term)
   -> NamesT ReduceM Term
   -> NamesT ReduceM Term
   -> NamesT ReduceM Term)
-> NamesT
     ReduceM
     (Maybe
        ((NamesT ReduceM Term -> NamesT ReduceM Term)
         -> NamesT ReduceM Term
         -> NamesT ReduceM Term
         -> NamesT ReduceM Term))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe
   ((NamesT ReduceM Term -> NamesT ReduceM Term)
    -> NamesT ReduceM Term
    -> NamesT ReduceM Term
    -> NamesT ReduceM Term)
 -> NamesT
      ReduceM
      (Maybe
         ((NamesT ReduceM Term -> NamesT ReduceM Term)
          -> NamesT ReduceM Term
          -> NamesT ReduceM Term
          -> NamesT ReduceM Term)))
-> Maybe
     ((NamesT ReduceM Term -> NamesT ReduceM Term)
      -> NamesT ReduceM Term
      -> NamesT ReduceM Term
      -> NamesT ReduceM Term)
-> NamesT
     ReduceM
     (Maybe
        ((NamesT ReduceM Term -> NamesT ReduceM Term)
         -> NamesT ReduceM Term
         -> NamesT ReduceM Term
         -> NamesT ReduceM Term))
forall a b. (a -> b) -> a -> b
$ ((NamesT ReduceM Term -> NamesT ReduceM Term)
 -> NamesT ReduceM Term
 -> NamesT ReduceM Term
 -> NamesT ReduceM Term)
-> Maybe
     ((NamesT ReduceM Term -> NamesT ReduceM Term)
      -> NamesT ReduceM Term
      -> NamesT ReduceM Term
      -> NamesT ReduceM Term)
forall a. a -> Maybe a
Just (((NamesT ReduceM Term -> NamesT ReduceM Term)
  -> NamesT ReduceM Term
  -> NamesT ReduceM Term
  -> NamesT ReduceM Term)
 -> Maybe
      ((NamesT ReduceM Term -> NamesT ReduceM Term)
       -> NamesT ReduceM Term
       -> NamesT ReduceM Term
       -> NamesT ReduceM Term))
-> ((NamesT ReduceM Term -> NamesT ReduceM Term)
    -> NamesT ReduceM Term
    -> NamesT ReduceM Term
    -> NamesT ReduceM Term)
-> Maybe
     ((NamesT ReduceM Term -> NamesT ReduceM Term)
      -> NamesT ReduceM Term
      -> NamesT ReduceM Term
      -> NamesT ReduceM Term)
forall a b. (a -> b) -> a -> b
$ \ NamesT ReduceM Term -> NamesT ReduceM Term
iOrNot NamesT ReduceM Term
phi NamesT ReduceM Term
a0 -> Term -> NamesT ReduceM Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
tTrans NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> String
-> (NamesT ReduceM Term -> NamesT ReduceM Term)
-> NamesT ReduceM Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
lam String
"j" (\ NamesT ReduceM Term
j -> NamesT ReduceM Term
la NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT ReduceM Term -> NamesT ReduceM Term
iOrNot NamesT ReduceM Term
j)
                                                         NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> String
-> (NamesT ReduceM Term -> NamesT ReduceM Term)
-> NamesT ReduceM Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
lam String
"j" (\ NamesT ReduceM Term
j -> NamesT ReduceM Term
bA NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT ReduceM Term -> NamesT ReduceM Term
iOrNot NamesT ReduceM Term
j)
                                                         NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT ReduceM Term
phi
                                                         NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT ReduceM Term
a0
          Sort' Term
LockUniv -> Maybe
  ((NamesT ReduceM Term -> NamesT ReduceM Term)
   -> NamesT ReduceM Term
   -> NamesT ReduceM Term
   -> NamesT ReduceM Term)
-> NamesT
     ReduceM
     (Maybe
        ((NamesT ReduceM Term -> NamesT ReduceM Term)
         -> NamesT ReduceM Term
         -> NamesT ReduceM Term
         -> NamesT ReduceM Term))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe
   ((NamesT ReduceM Term -> NamesT ReduceM Term)
    -> NamesT ReduceM Term
    -> NamesT ReduceM Term
    -> NamesT ReduceM Term)
 -> NamesT
      ReduceM
      (Maybe
         ((NamesT ReduceM Term -> NamesT ReduceM Term)
          -> NamesT ReduceM Term
          -> NamesT ReduceM Term
          -> NamesT ReduceM Term)))
-> Maybe
     ((NamesT ReduceM Term -> NamesT ReduceM Term)
      -> NamesT ReduceM Term
      -> NamesT ReduceM Term
      -> NamesT ReduceM Term)
-> NamesT
     ReduceM
     (Maybe
        ((NamesT ReduceM Term -> NamesT ReduceM Term)
         -> NamesT ReduceM Term
         -> NamesT ReduceM Term
         -> NamesT ReduceM Term))
forall a b. (a -> b) -> a -> b
$ ((NamesT ReduceM Term -> NamesT ReduceM Term)
 -> NamesT ReduceM Term
 -> NamesT ReduceM Term
 -> NamesT ReduceM Term)
-> Maybe
     ((NamesT ReduceM Term -> NamesT ReduceM Term)
      -> NamesT ReduceM Term
      -> NamesT ReduceM Term
      -> NamesT ReduceM Term)
forall a. a -> Maybe a
Just (((NamesT ReduceM Term -> NamesT ReduceM Term)
  -> NamesT ReduceM Term
  -> NamesT ReduceM Term
  -> NamesT ReduceM Term)
 -> Maybe
      ((NamesT ReduceM Term -> NamesT ReduceM Term)
       -> NamesT ReduceM Term
       -> NamesT ReduceM Term
       -> NamesT ReduceM Term))
-> ((NamesT ReduceM Term -> NamesT ReduceM Term)
    -> NamesT ReduceM Term
    -> NamesT ReduceM Term
    -> NamesT ReduceM Term)
-> Maybe
     ((NamesT ReduceM Term -> NamesT ReduceM Term)
      -> NamesT ReduceM Term
      -> NamesT ReduceM Term
      -> NamesT ReduceM Term)
forall a b. (a -> b) -> a -> b
$ \ NamesT ReduceM Term -> NamesT ReduceM Term
_ NamesT ReduceM Term
_ NamesT ReduceM Term
a0 -> NamesT ReduceM Term
a0
          Sort' Term
_       -> Maybe
  ((NamesT ReduceM Term -> NamesT ReduceM Term)
   -> NamesT ReduceM Term
   -> NamesT ReduceM Term
   -> NamesT ReduceM Term)
-> NamesT
     ReduceM
     (Maybe
        ((NamesT ReduceM Term -> NamesT ReduceM Term)
         -> NamesT ReduceM Term
         -> NamesT ReduceM Term
         -> NamesT ReduceM Term))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe
  ((NamesT ReduceM Term -> NamesT ReduceM Term)
   -> NamesT ReduceM Term
   -> NamesT ReduceM Term
   -> NamesT ReduceM Term)
forall a. Maybe a
Nothing
      Maybe
  ((NamesT ReduceM Term -> NamesT ReduceM Term)
   -> NamesT ReduceM Term
   -> NamesT ReduceM Term
   -> NamesT ReduceM Term)
-> NamesT ReduceM (Maybe Term)
-> (((NamesT ReduceM Term -> NamesT ReduceM Term)
     -> NamesT ReduceM Term
     -> NamesT ReduceM Term
     -> NamesT ReduceM Term)
    -> NamesT ReduceM (Maybe Term))
-> NamesT ReduceM (Maybe Term)
forall a b. Maybe a -> b -> (a -> b) -> b
caseMaybe Maybe
  ((NamesT ReduceM Term -> NamesT ReduceM Term)
   -> NamesT ReduceM Term
   -> NamesT ReduceM Term
   -> NamesT ReduceM Term)
labA (Maybe Term -> NamesT ReduceM (Maybe Term)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Term
forall a. Maybe a
Nothing) ((((NamesT ReduceM Term -> NamesT ReduceM Term)
   -> NamesT ReduceM Term
   -> NamesT ReduceM Term
   -> NamesT ReduceM Term)
  -> NamesT ReduceM (Maybe Term))
 -> NamesT ReduceM (Maybe Term))
-> (((NamesT ReduceM Term -> NamesT ReduceM Term)
     -> NamesT ReduceM Term
     -> NamesT ReduceM Term
     -> NamesT ReduceM Term)
    -> NamesT ReduceM (Maybe Term))
-> NamesT ReduceM (Maybe Term)
forall a b. (a -> b) -> a -> b
$ \ (NamesT ReduceM Term -> NamesT ReduceM Term)
-> NamesT ReduceM Term
-> NamesT ReduceM Term
-> NamesT ReduceM Term
trA -> Term -> Maybe Term
forall a. a -> Maybe a
Just (Term -> Maybe Term)
-> NamesT ReduceM Term -> NamesT ReduceM (Maybe Term)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
      [NamesT ReduceM Term
phi, NamesT ReduceM Term
u0] <- (Arg Term -> NamesT ReduceM (NamesT ReduceM Term))
-> [Arg Term] -> NamesT ReduceM [NamesT ReduceM Term]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Term -> NamesT ReduceM (NamesT ReduceM Term)
forall (m :: * -> *) a.
(MonadFail m, Subst a) =>
a -> NamesT m (NamesT m a)
open (Term -> NamesT ReduceM (NamesT ReduceM Term))
-> (Arg Term -> Term)
-> Arg Term
-> NamesT ReduceM (NamesT ReduceM Term)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Arg Term -> Term
forall e. Arg e -> e
unArg) [Arg Term
phi, Arg Term
u0]
      Maybe (NamesT ReduceM Term)
u <- (Term -> NamesT ReduceM (NamesT ReduceM Term))
-> Maybe Term -> NamesT ReduceM (Maybe (NamesT ReduceM Term))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Term -> NamesT ReduceM (NamesT ReduceM Term)
forall (m :: * -> *) a.
(MonadFail m, Subst a) =>
a -> NamesT m (NamesT m a)
open (Arg Term -> Term
forall e. Arg e -> e
unArg (Arg Term -> Term) -> Maybe (Arg Term) -> Maybe Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Arg Term)
u)

      ArgInfo
-> String
-> (NamesT ReduceM Term -> NamesT ReduceM Term)
-> NamesT ReduceM Term
forall (m :: * -> *).
MonadFail m =>
ArgInfo
-> String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
glam (Dom Type -> ArgInfo
forall a. LensArgInfo a => a -> ArgInfo
getArgInfo ((Dom Type, Abs Type) -> Dom Type
forall a b. (a, b) -> a
fst ((Dom Type, Abs Type) -> Dom Type)
-> (Dom Type, Abs Type) -> Dom Type
forall a b. (a -> b) -> a -> b
$ FamilyOrNot (Dom Type, Abs Type) -> (Dom Type, Abs Type)
forall a. FamilyOrNot a -> a
famThing FamilyOrNot (Dom Type, Abs Type)
ab)) (Abs Type -> String
forall a. Abs a -> String
absName (Abs Type -> String) -> Abs Type -> String
forall a b. (a -> b) -> a -> b
$ (Dom Type, Abs Type) -> Abs Type
forall a b. (a, b) -> b
snd ((Dom Type, Abs Type) -> Abs Type)
-> (Dom Type, Abs Type) -> Abs Type
forall a b. (a -> b) -> a -> b
$ FamilyOrNot (Dom Type, Abs Type) -> (Dom Type, Abs Type)
forall a. FamilyOrNot a -> a
famThing FamilyOrNot (Dom Type, Abs Type)
ab) ((NamesT ReduceM Term -> NamesT ReduceM Term)
 -> NamesT ReduceM Term)
-> (NamesT ReduceM Term -> NamesT ReduceM Term)
-> NamesT ReduceM Term
forall a b. (a -> b) -> a -> b
$ \ NamesT ReduceM Term
u1 -> do
        case (TranspOrHComp
cmd, FamilyOrNot (Dom Type, Abs Type)
ab, Maybe (NamesT ReduceM Term)
u) of
          (TranspOrHComp
DoHComp, IsNot (Dom Type
a , Abs Type
b), Just NamesT ReduceM Term
u) -> do
            Type
bT <- (Arity -> Abs Type -> Abs Type
forall a. Subst a => Arity -> a -> a
raise Arity
1 Abs Type
b Abs Type -> SubstArg Type -> Type
forall a. Subst a => Abs a -> SubstArg a -> a
`absApp`) (Term -> Type) -> NamesT ReduceM Term -> NamesT ReduceM Type
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamesT ReduceM Term
u1
            let v :: NamesT ReduceM Term
v = NamesT ReduceM Term
u1
            Term -> NamesT ReduceM Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
tHComp NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> (Level' Term -> Term
Level (Level' Term -> Term)
-> NamesT ReduceM (Level' Term) -> NamesT ReduceM Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Type -> NamesT ReduceM (Level' Term)
forall (f :: * -> *) a.
(MonadReduce f, LensSort a) =>
a -> f (Level' Term)
toLevel Type
bT)
                        NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> Term -> NamesT ReduceM Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Type -> Term
forall t a. Type'' t a -> a
unEl                      (Type -> Term) -> Type -> Term
forall a b. (a -> b) -> a -> b
$ Type
bT)
                        NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> NamesT ReduceM Term
phi
                        NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> String
-> (NamesT ReduceM Term -> NamesT ReduceM Term)
-> NamesT ReduceM Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
lam String
"i" (\ NamesT ReduceM Term
i -> String
-> (NamesT ReduceM Term -> NamesT ReduceM Term)
-> NamesT ReduceM Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
ilam String
"o" ((NamesT ReduceM Term -> NamesT ReduceM Term)
 -> NamesT ReduceM Term)
-> (NamesT ReduceM Term -> NamesT ReduceM Term)
-> NamesT ReduceM Term
forall a b. (a -> b) -> a -> b
$ \ NamesT ReduceM Term
o -> Hiding
-> NamesT ReduceM Term
-> NamesT ReduceM Term
-> NamesT ReduceM Term
forall (m :: * -> *).
Applicative m =>
Hiding -> m Term -> m Term -> m Term
gApply (Dom Type -> Hiding
forall a. LensHiding a => a -> Hiding
getHiding Dom Type
a) (NamesT ReduceM Term
u NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT ReduceM Term
i NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<..> NamesT ReduceM Term
o) NamesT ReduceM Term
v)
                        NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> (Hiding
-> NamesT ReduceM Term
-> NamesT ReduceM Term
-> NamesT ReduceM Term
forall (m :: * -> *).
Applicative m =>
Hiding -> m Term -> m Term -> m Term
gApply (Dom Type -> Hiding
forall a. LensHiding a => a -> Hiding
getHiding Dom Type
a) NamesT ReduceM Term
u0 NamesT ReduceM Term
v)
          (TranspOrHComp
DoTransp, IsFam (Dom Type
a , Abs Type
b), Maybe (NamesT ReduceM Term)
Nothing) -> do
            let v :: NamesT ReduceM Term -> NamesT ReduceM Term
v NamesT ReduceM Term
i = do
                       let
                         iOrNot :: NamesT ReduceM Term -> NamesT ReduceM Term
iOrNot NamesT ReduceM Term
j = Term -> NamesT ReduceM Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
tIMax NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT ReduceM Term
i NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> (Term -> NamesT ReduceM Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
tINeg NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT ReduceM Term
j)
                       (NamesT ReduceM Term -> NamesT ReduceM Term)
-> NamesT ReduceM Term
-> NamesT ReduceM Term
-> NamesT ReduceM Term
trA NamesT ReduceM Term -> NamesT ReduceM Term
iOrNot (Term -> NamesT ReduceM Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
tIMax NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT ReduceM Term
phi NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT ReduceM Term
i)
                                  NamesT ReduceM Term
u1
                -- Γ , u1 : A[i1] , i : I
                bB :: Term -> Type
bB Term
v = Term -> Substitution' Term -> Substitution' Term
forall a. DeBruijn a => a -> Substitution' a -> Substitution' a
consS Term
v (Arity -> Substitution' Term -> Substitution' Term
forall a. Arity -> Substitution' a -> Substitution' a
liftS Arity
1 (Substitution' Term -> Substitution' Term)
-> Substitution' Term -> Substitution' Term
forall a b. (a -> b) -> a -> b
$ Arity -> Substitution' Term
forall a. Arity -> Substitution' a
raiseS Arity
1) Substitution' (SubstArg Type) -> Type -> Type
forall a. Subst a => Substitution' (SubstArg a) -> a -> a
`applySubst` (Abs Type -> Type
forall a. Subst a => Abs a -> a
absBody Abs Type
b {- Γ , i : I , x : A[i] -})
                tLam :: Abs Term -> Term
tLam = ArgInfo -> Abs Term -> Term
Lam ArgInfo
defaultArgInfo
            Abs Type
bT <- String
-> (NamesT ReduceM Term -> NamesT ReduceM Type)
-> NamesT ReduceM (Abs Type)
forall (m :: * -> *) b a.
(MonadFail m, Subst b, DeBruijn b, Subst a, Free a) =>
String -> (NamesT m b -> NamesT m a) -> NamesT m (Abs a)
bind String
"i" ((NamesT ReduceM Term -> NamesT ReduceM Type)
 -> NamesT ReduceM (Abs Type))
-> (NamesT ReduceM Term -> NamesT ReduceM Type)
-> NamesT ReduceM (Abs Type)
forall a b. (a -> b) -> a -> b
$ (Term -> Type) -> NamesT ReduceM Term -> NamesT ReduceM Type
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Term -> Type
bB (NamesT ReduceM Term -> NamesT ReduceM Type)
-> (NamesT ReduceM Term -> NamesT ReduceM Term)
-> NamesT ReduceM Term
-> NamesT ReduceM Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NamesT ReduceM Term -> NamesT ReduceM Term
v
            -- Γ , u1 : A[i1]
            (Term -> NamesT ReduceM Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
tTrans NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> (Abs Term -> Term
tLam (Abs Term -> Term)
-> NamesT ReduceM (Abs Term) -> NamesT ReduceM Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Type -> NamesT ReduceM Term)
-> Abs Type -> NamesT ReduceM (Abs Term)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((Level' Term -> Term)
-> NamesT ReduceM (Level' Term) -> NamesT ReduceM Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Level' Term -> Term
Level (NamesT ReduceM (Level' Term) -> NamesT ReduceM Term)
-> (Type -> NamesT ReduceM (Level' Term))
-> Type
-> NamesT ReduceM Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type -> NamesT ReduceM (Level' Term)
forall (f :: * -> *) a.
(MonadReduce f, LensSort a) =>
a -> f (Level' Term)
toLevel) Abs Type
bT)
                         NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> (Term -> NamesT ReduceM Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term -> NamesT ReduceM Term)
-> (Abs Term -> Term) -> Abs Term -> NamesT ReduceM Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Abs Term -> Term
tLam (Abs Term -> NamesT ReduceM Term)
-> Abs Term -> NamesT ReduceM Term
forall a b. (a -> b) -> a -> b
$ Type -> Term
forall t a. Type'' t a -> a
unEl                      (Type -> Term) -> Abs Type -> Abs Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Abs Type
bT)
                         NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT ReduceM Term
phi
                         NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> Hiding
-> NamesT ReduceM Term
-> NamesT ReduceM Term
-> NamesT ReduceM Term
forall (m :: * -> *).
Applicative m =>
Hiding -> m Term -> m Term -> m Term
gApply (Dom Type -> Hiding
forall a. LensHiding a => a -> Hiding
getHiding Dom Type
a) NamesT ReduceM Term
u0 (NamesT ReduceM Term -> NamesT ReduceM Term
v (Term -> NamesT ReduceM Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
iz)))
          (TranspOrHComp
_,FamilyOrNot (Dom Type, Abs Type)
_,Maybe (NamesT ReduceM Term)
_) -> NamesT ReduceM Term
forall a. HasCallStack => a
__IMPOSSIBLE__
    compPathP :: TranspOrHComp
-> Blocked' t (Arg Term)
-> Maybe (Arg Term)
-> Arg Term
-> FamilyOrNot (Arg Term)
-> FamilyOrNot (Arg Term, Arg Term, Arg Term)
-> ReduceM (Reduced a' Term)
compPathP cmd :: TranspOrHComp
cmd@TranspOrHComp
DoHComp Blocked' t (Arg Term)
sphi (Just Arg Term
u) Arg Term
u0 (IsNot Arg Term
l) (IsNot (Arg Term
bA,Arg Term
x,Arg Term
y)) = do
      let getTermLocal :: String -> ReduceM Term
getTermLocal = String -> String -> ReduceM Term
forall (m :: * -> *). HasBuiltins m => String -> String -> m Term
getTerm (String -> String -> ReduceM Term)
-> String -> String -> ReduceM Term
forall a b. (a -> b) -> a -> b
$ TranspOrHComp -> String
cmdToName TranspOrHComp
cmd String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" for path types"
      Term
tHComp <- String -> ReduceM Term
getTermLocal String
builtinHComp
      Term
tINeg <- String -> ReduceM Term
getTermLocal String
builtinINeg
      Term
tIMax <- String -> ReduceM Term
getTermLocal String
builtinIMax
      Term
tOr   <- String -> ReduceM Term
getTermLocal String
"primPOr"
      let
        ineg :: NamesT Fail Term -> NamesT Fail Term
ineg NamesT Fail Term
j = Term -> NamesT Fail Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
tINeg NamesT Fail Term -> NamesT Fail Term -> NamesT Fail Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT Fail Term
j
        imax :: NamesT Fail Term -> NamesT Fail Term -> NamesT Fail Term
imax NamesT Fail Term
i NamesT Fail Term
j = Term -> NamesT Fail Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
tIMax NamesT Fail Term -> NamesT Fail Term -> NamesT Fail Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT Fail Term
i NamesT Fail Term -> NamesT Fail Term -> NamesT Fail Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT Fail Term
j

      Term -> ReduceM (Reduced a' Term)
forall a a'. a -> ReduceM (Reduced a' a)
redReturn (Term -> ReduceM (Reduced a' Term))
-> (NamesT Fail Term -> Term)
-> NamesT Fail Term
-> ReduceM (Reduced a' Term)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Names -> NamesT Fail Term -> Term
forall a. Names -> NamesT Fail a -> a
runNames [] (NamesT Fail Term -> ReduceM (Reduced a' Term))
-> NamesT Fail Term -> ReduceM (Reduced a' Term)
forall a b. (a -> b) -> a -> b
$ do
         [NamesT Fail Term
l,NamesT Fail Term
u,NamesT Fail Term
u0] <- (Arg Term -> NamesT Fail (NamesT Fail Term))
-> [Arg Term] -> NamesT Fail [NamesT Fail Term]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Term -> NamesT Fail (NamesT Fail Term)
forall (m :: * -> *) a.
(MonadFail m, Subst a) =>
a -> NamesT m (NamesT m a)
open (Term -> NamesT Fail (NamesT Fail Term))
-> (Arg Term -> Term) -> Arg Term -> NamesT Fail (NamesT Fail Term)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Arg Term -> Term
forall e. Arg e -> e
unArg) [Arg Term
l,Arg Term
u,Arg Term
u0]
         NamesT Fail Term
phi      <- Term -> NamesT Fail (NamesT Fail Term)
forall (m :: * -> *) a.
(MonadFail m, Subst a) =>
a -> NamesT m (NamesT m a)
open (Term -> NamesT Fail (NamesT Fail Term))
-> (Blocked' t (Arg Term) -> Term)
-> Blocked' t (Arg Term)
-> NamesT Fail (NamesT Fail Term)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Arg Term -> Term
forall e. Arg e -> e
unArg (Arg Term -> Term)
-> (Blocked' t (Arg Term) -> Arg Term)
-> Blocked' t (Arg Term)
-> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Blocked' t (Arg Term) -> Arg Term
forall t a. Blocked' t a -> a
ignoreBlocking (Blocked' t (Arg Term) -> NamesT Fail (NamesT Fail Term))
-> Blocked' t (Arg Term) -> NamesT Fail (NamesT Fail Term)
forall a b. (a -> b) -> a -> b
$ Blocked' t (Arg Term)
sphi
         [NamesT Fail Term
bA, NamesT Fail Term
x, NamesT Fail Term
y] <- (Arg Term -> NamesT Fail (NamesT Fail Term))
-> [Arg Term] -> NamesT Fail [NamesT Fail Term]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Term -> NamesT Fail (NamesT Fail Term)
forall (m :: * -> *) a.
(MonadFail m, Subst a) =>
a -> NamesT m (NamesT m a)
open (Term -> NamesT Fail (NamesT Fail Term))
-> (Arg Term -> Term) -> Arg Term -> NamesT Fail (NamesT Fail Term)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Arg Term -> Term
forall e. Arg e -> e
unArg) [Arg Term
bA, Arg Term
x, Arg Term
y]
         String
-> (NamesT Fail Term -> NamesT Fail Term) -> NamesT Fail Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
lam String
"j" ((NamesT Fail Term -> NamesT Fail Term) -> NamesT Fail Term)
-> (NamesT Fail Term -> NamesT Fail Term) -> NamesT Fail Term
forall a b. (a -> b) -> a -> b
$ \ NamesT Fail Term
j ->
           Term -> NamesT Fail Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
tHComp NamesT Fail Term -> NamesT Fail Term -> NamesT Fail Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> NamesT Fail Term
l
                       NamesT Fail Term -> NamesT Fail Term -> NamesT Fail Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> (NamesT Fail Term
bA NamesT Fail Term -> NamesT Fail Term -> NamesT Fail Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT Fail Term
j)
                       NamesT Fail Term -> NamesT Fail Term -> NamesT Fail Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> (NamesT Fail Term
phi NamesT Fail Term -> NamesT Fail Term -> NamesT Fail Term
`imax` (NamesT Fail Term -> NamesT Fail Term
ineg NamesT Fail Term
j NamesT Fail Term -> NamesT Fail Term -> NamesT Fail Term
`imax` NamesT Fail Term
j))
                       NamesT Fail Term -> NamesT Fail Term -> NamesT Fail Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> String
-> (NamesT Fail Term -> NamesT Fail Term) -> NamesT Fail Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
lam String
"i'" (\ NamesT Fail Term
i ->
                            let or :: NamesT Fail Term -> NamesT Fail Term -> NamesT Fail Term
or NamesT Fail Term
f1 NamesT Fail Term
f2 = Term -> NamesT Fail Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
tOr NamesT Fail Term -> NamesT Fail Term -> NamesT Fail Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> NamesT Fail Term
l NamesT Fail Term -> NamesT Fail Term -> NamesT Fail Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT Fail Term
f1 NamesT Fail Term -> NamesT Fail Term -> NamesT Fail Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT Fail Term
f2 NamesT Fail Term -> NamesT Fail Term -> NamesT Fail Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> String
-> (NamesT Fail Term -> NamesT Fail Term) -> NamesT Fail Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
lam String
"_" (\ NamesT Fail Term
_ -> NamesT Fail Term
bA NamesT Fail Term -> NamesT Fail Term -> NamesT Fail Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT Fail Term
i)
                            in NamesT Fail Term -> NamesT Fail Term -> NamesT Fail Term
or NamesT Fail Term
phi (NamesT Fail Term -> NamesT Fail Term
ineg NamesT Fail Term
j NamesT Fail Term -> NamesT Fail Term -> NamesT Fail Term
`imax` NamesT Fail Term
j)
                                          NamesT Fail Term -> NamesT Fail Term -> NamesT Fail Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> String
-> (NamesT Fail Term -> NamesT Fail Term) -> NamesT Fail Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
ilam String
"o" (\ NamesT Fail Term
o -> NamesT Fail Term
u NamesT Fail Term -> NamesT Fail Term -> NamesT Fail Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT Fail Term
i NamesT Fail Term -> NamesT Fail Term -> NamesT Fail Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<..> NamesT Fail Term
o NamesT Fail Term
-> (NamesT Fail Term, NamesT Fail Term, NamesT Fail Term)
-> NamesT Fail Term
forall (m :: * -> *).
Applicative m =>
m Term -> (m Term, m Term, m Term) -> m Term
<@@> (NamesT Fail Term
x, NamesT Fail Term
y, NamesT Fail Term
j)) -- a0 <@@> (x <@> i, y <@> i, j)
                                          NamesT Fail Term -> NamesT Fail Term -> NamesT Fail Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> (NamesT Fail Term -> NamesT Fail Term -> NamesT Fail Term
or (NamesT Fail Term -> NamesT Fail Term
ineg NamesT Fail Term
j) NamesT Fail Term
j NamesT Fail Term -> NamesT Fail Term -> NamesT Fail Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> String
-> (NamesT Fail Term -> NamesT Fail Term) -> NamesT Fail Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
ilam String
"_" (NamesT Fail Term -> NamesT Fail Term -> NamesT Fail Term
forall a b. a -> b -> a
const NamesT Fail Term
x)
                                                                  NamesT Fail Term -> NamesT Fail Term -> NamesT Fail Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> String
-> (NamesT Fail Term -> NamesT Fail Term) -> NamesT Fail Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
ilam String
"_" (NamesT Fail Term -> NamesT Fail Term -> NamesT Fail Term
forall a b. a -> b -> a
const NamesT Fail Term
y)))
                       NamesT Fail Term -> NamesT Fail Term -> NamesT Fail Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> (NamesT Fail Term
u0 NamesT Fail Term
-> (NamesT Fail Term, NamesT Fail Term, NamesT Fail Term)
-> NamesT Fail Term
forall (m :: * -> *).
Applicative m =>
m Term -> (m Term, m Term, m Term) -> m Term
<@@> (NamesT Fail Term
x, NamesT Fail Term
y, NamesT Fail Term
j))
    compPathP cmd :: TranspOrHComp
cmd@TranspOrHComp
DoTransp Blocked' t (Arg Term)
sphi Maybe (Arg Term)
Nothing Arg Term
u0 (IsFam Arg Term
l) (IsFam (Arg Term
bA,Arg Term
x,Arg Term
y)) = do
      -- Γ    ⊢ l
      -- Γ, i ⊢ bA, x, y
      let getTermLocal :: String -> ReduceM Term
getTermLocal = String -> String -> ReduceM Term
forall (m :: * -> *). HasBuiltins m => String -> String -> m Term
getTerm (String -> String -> ReduceM Term)
-> String -> String -> ReduceM Term
forall a b. (a -> b) -> a -> b
$ TranspOrHComp -> String
cmdToName TranspOrHComp
cmd String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" for path types"
      Term
tINeg <- String -> ReduceM Term
getTermLocal String
builtinINeg
      Term
tIMax <- String -> ReduceM Term
getTermLocal String
builtinIMax
      Term
tOr   <- String -> ReduceM Term
getTermLocal String
"primPOr"
      Term
iz <- String -> ReduceM Term
getTermLocal String
builtinIZero
      Term
io <- String -> ReduceM Term
getTermLocal String
builtinIOne
      let
        ineg :: NamesT Fail Term -> NamesT Fail Term
ineg NamesT Fail Term
j = Term -> NamesT Fail Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
tINeg NamesT Fail Term -> NamesT Fail Term -> NamesT Fail Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT Fail Term
j
        imax :: NamesT Fail Term -> NamesT Fail Term -> NamesT Fail Term
imax NamesT Fail Term
i NamesT Fail Term
j = Term -> NamesT Fail Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
tIMax NamesT Fail Term -> NamesT Fail Term -> NamesT Fail Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT Fail Term
i NamesT Fail Term -> NamesT Fail Term -> NamesT Fail Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT Fail Term
j
      NamesT Fail Term
-> NamesT Fail Term
-> NamesT Fail Term
-> NamesT Fail Term
-> NamesT Fail Term
-> NamesT Fail Term
comp <- do
        Term
tHComp <- String -> ReduceM Term
getTermLocal String
builtinHComp
        Term
tTrans <- String -> ReduceM Term
getTermLocal String
builtinTrans
        let forward :: NamesT Fail Term
-> NamesT Fail Term
-> NamesT Fail Term
-> NamesT Fail Term
-> NamesT Fail Term
forward NamesT Fail Term
la NamesT Fail Term
bA NamesT Fail Term
r NamesT Fail Term
u = Term -> NamesT Fail Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
tTrans NamesT Fail Term -> NamesT Fail Term -> NamesT Fail Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> String
-> (NamesT Fail Term -> NamesT Fail Term) -> NamesT Fail Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
lam String
"i" (\ NamesT Fail Term
i -> NamesT Fail Term
la NamesT Fail Term -> NamesT Fail Term -> NamesT Fail Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> (NamesT Fail Term
i NamesT Fail Term -> NamesT Fail Term -> NamesT Fail Term
`imax` NamesT Fail Term
r))
                                            NamesT Fail Term -> NamesT Fail Term -> NamesT Fail Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> String
-> (NamesT Fail Term -> NamesT Fail Term) -> NamesT Fail Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
lam String
"i" (\ NamesT Fail Term
i -> NamesT Fail Term
bA NamesT Fail Term -> NamesT Fail Term -> NamesT Fail Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> (NamesT Fail Term
i NamesT Fail Term -> NamesT Fail Term -> NamesT Fail Term
`imax` NamesT Fail Term
r))
                                            NamesT Fail Term -> NamesT Fail Term -> NamesT Fail Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT Fail Term
r
                                            NamesT Fail Term -> NamesT Fail Term -> NamesT Fail Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT Fail Term
u
        (NamesT Fail Term
 -> NamesT Fail Term
 -> NamesT Fail Term
 -> NamesT Fail Term
 -> NamesT Fail Term
 -> NamesT Fail Term)
-> ReduceM
     (NamesT Fail Term
      -> NamesT Fail Term
      -> NamesT Fail Term
      -> NamesT Fail Term
      -> NamesT Fail Term
      -> NamesT Fail Term)
forall (m :: * -> *) a. Monad m => a -> m a
return ((NamesT Fail Term
  -> NamesT Fail Term
  -> NamesT Fail Term
  -> NamesT Fail Term
  -> NamesT Fail Term
  -> NamesT Fail Term)
 -> ReduceM
      (NamesT Fail Term
       -> NamesT Fail Term
       -> NamesT Fail Term
       -> NamesT Fail Term
       -> NamesT Fail Term
       -> NamesT Fail Term))
-> (NamesT Fail Term
    -> NamesT Fail Term
    -> NamesT Fail Term
    -> NamesT Fail Term
    -> NamesT Fail Term
    -> NamesT Fail Term)
-> ReduceM
     (NamesT Fail Term
      -> NamesT Fail Term
      -> NamesT Fail Term
      -> NamesT Fail Term
      -> NamesT Fail Term
      -> NamesT Fail Term)
forall a b. (a -> b) -> a -> b
$ \ NamesT Fail Term
la NamesT Fail Term
bA NamesT Fail Term
phi NamesT Fail Term
u NamesT Fail Term
u0 ->
          Term -> NamesT Fail Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
tHComp NamesT Fail Term -> NamesT Fail Term -> NamesT Fail Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> (NamesT Fail Term
la NamesT Fail Term -> NamesT Fail Term -> NamesT Fail Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> Term -> NamesT Fail Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
io)
                      NamesT Fail Term -> NamesT Fail Term -> NamesT Fail Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> (NamesT Fail Term
bA NamesT Fail Term -> NamesT Fail Term -> NamesT Fail Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> Term -> NamesT Fail Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
io)
                      NamesT Fail Term -> NamesT Fail Term -> NamesT Fail Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> NamesT Fail Term
phi
                      NamesT Fail Term -> NamesT Fail Term -> NamesT Fail Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> String
-> (NamesT Fail Term -> NamesT Fail Term) -> NamesT Fail Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
lam String
"i" (\ NamesT Fail Term
i -> String
-> (NamesT Fail Term -> NamesT Fail Term) -> NamesT Fail Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
ilam String
"o" ((NamesT Fail Term -> NamesT Fail Term) -> NamesT Fail Term)
-> (NamesT Fail Term -> NamesT Fail Term) -> NamesT Fail Term
forall a b. (a -> b) -> a -> b
$ \ NamesT Fail Term
o ->
                              NamesT Fail Term
-> NamesT Fail Term
-> NamesT Fail Term
-> NamesT Fail Term
-> NamesT Fail Term
forward NamesT Fail Term
la NamesT Fail Term
bA NamesT Fail Term
i (NamesT Fail Term
u NamesT Fail Term -> NamesT Fail Term -> NamesT Fail Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT Fail Term
i NamesT Fail Term -> NamesT Fail Term -> NamesT Fail Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<..> NamesT Fail Term
o))
                      NamesT Fail Term -> NamesT Fail Term -> NamesT Fail Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT Fail Term
-> NamesT Fail Term
-> NamesT Fail Term
-> NamesT Fail Term
-> NamesT Fail Term
forward NamesT Fail Term
la NamesT Fail Term
bA (Term -> NamesT Fail Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
iz) NamesT Fail Term
u0
      Term -> ReduceM (Reduced a' Term)
forall a a'. a -> ReduceM (Reduced a' a)
redReturn (Term -> ReduceM (Reduced a' Term))
-> (NamesT Fail Term -> Term)
-> NamesT Fail Term
-> ReduceM (Reduced a' Term)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Names -> NamesT Fail Term -> Term
forall a. Names -> NamesT Fail a -> a
runNames [] (NamesT Fail Term -> ReduceM (Reduced a' Term))
-> NamesT Fail Term -> ReduceM (Reduced a' Term)
forall a b. (a -> b) -> a -> b
$ do
        [NamesT Fail Term
l,NamesT Fail Term
u0] <- (Arg Term -> NamesT Fail (NamesT Fail Term))
-> [Arg Term] -> NamesT Fail [NamesT Fail Term]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Term -> NamesT Fail (NamesT Fail Term)
forall (m :: * -> *) a.
(MonadFail m, Subst a) =>
a -> NamesT m (NamesT m a)
open (Term -> NamesT Fail (NamesT Fail Term))
-> (Arg Term -> Term) -> Arg Term -> NamesT Fail (NamesT Fail Term)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Arg Term -> Term
forall e. Arg e -> e
unArg) [Arg Term
l,Arg Term
u0]
        NamesT Fail Term
phi      <- Term -> NamesT Fail (NamesT Fail Term)
forall (m :: * -> *) a.
(MonadFail m, Subst a) =>
a -> NamesT m (NamesT m a)
open (Term -> NamesT Fail (NamesT Fail Term))
-> (Blocked' t (Arg Term) -> Term)
-> Blocked' t (Arg Term)
-> NamesT Fail (NamesT Fail Term)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Arg Term -> Term
forall e. Arg e -> e
unArg (Arg Term -> Term)
-> (Blocked' t (Arg Term) -> Arg Term)
-> Blocked' t (Arg Term)
-> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Blocked' t (Arg Term) -> Arg Term
forall t a. Blocked' t a -> a
ignoreBlocking (Blocked' t (Arg Term) -> NamesT Fail (NamesT Fail Term))
-> Blocked' t (Arg Term) -> NamesT Fail (NamesT Fail Term)
forall a b. (a -> b) -> a -> b
$ Blocked' t (Arg Term)
sphi
        [NamesT Fail Term
bA, NamesT Fail Term
x, NamesT Fail Term
y] <- (Arg Term -> NamesT Fail (NamesT Fail Term))
-> [Arg Term] -> NamesT Fail [NamesT Fail Term]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\ Arg Term
a -> Term -> NamesT Fail (NamesT Fail Term)
forall (m :: * -> *) a.
(MonadFail m, Subst a) =>
a -> NamesT m (NamesT m a)
open (Term -> NamesT Fail (NamesT Fail Term))
-> (NamesT Fail Term -> Term)
-> NamesT Fail Term
-> NamesT Fail (NamesT Fail Term)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Names -> NamesT Fail Term -> Term
forall a. Names -> NamesT Fail a -> a
runNames [] (NamesT Fail Term -> NamesT Fail (NamesT Fail Term))
-> NamesT Fail Term -> NamesT Fail (NamesT Fail Term)
forall a b. (a -> b) -> a -> b
$ String
-> (NamesT Fail Term -> NamesT Fail Term) -> NamesT Fail Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
lam String
"i" (NamesT Fail Term -> NamesT Fail Term -> NamesT Fail Term
forall a b. a -> b -> a
const (Term -> NamesT Fail Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term -> NamesT Fail Term) -> Term -> NamesT Fail Term
forall a b. (a -> b) -> a -> b
$ Arg Term -> Term
forall e. Arg e -> e
unArg Arg Term
a))) [Arg Term
bA, Arg Term
x, Arg Term
y]
        String
-> (NamesT Fail Term -> NamesT Fail Term) -> NamesT Fail Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
lam String
"j" ((NamesT Fail Term -> NamesT Fail Term) -> NamesT Fail Term)
-> (NamesT Fail Term -> NamesT Fail Term) -> NamesT Fail Term
forall a b. (a -> b) -> a -> b
$ \ NamesT Fail Term
j ->
          NamesT Fail Term
-> NamesT Fail Term
-> NamesT Fail Term
-> NamesT Fail Term
-> NamesT Fail Term
-> NamesT Fail Term
comp NamesT Fail Term
l (String
-> (NamesT Fail Term -> NamesT Fail Term) -> NamesT Fail Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
lam String
"i" ((NamesT Fail Term -> NamesT Fail Term) -> NamesT Fail Term)
-> (NamesT Fail Term -> NamesT Fail Term) -> NamesT Fail Term
forall a b. (a -> b) -> a -> b
$ \ NamesT Fail Term
i -> NamesT Fail Term
bA NamesT Fail Term -> NamesT Fail Term -> NamesT Fail Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT Fail Term
i NamesT Fail Term -> NamesT Fail Term -> NamesT Fail Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT Fail Term
j) (NamesT Fail Term
phi NamesT Fail Term -> NamesT Fail Term -> NamesT Fail Term
`imax` (NamesT Fail Term -> NamesT Fail Term
ineg NamesT Fail Term
j NamesT Fail Term -> NamesT Fail Term -> NamesT Fail Term
`imax` NamesT Fail Term
j))
                      (String
-> (NamesT Fail Term -> NamesT Fail Term) -> NamesT Fail Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
lam String
"i'" ((NamesT Fail Term -> NamesT Fail Term) -> NamesT Fail Term)
-> (NamesT Fail Term -> NamesT Fail Term) -> NamesT Fail Term
forall a b. (a -> b) -> a -> b
$ \ NamesT Fail Term
i ->
                            let or :: NamesT Fail Term -> NamesT Fail Term -> NamesT Fail Term
or NamesT Fail Term
f1 NamesT Fail Term
f2 = Term -> NamesT Fail Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
tOr NamesT Fail Term -> NamesT Fail Term -> NamesT Fail Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> NamesT Fail Term
l NamesT Fail Term -> NamesT Fail Term -> NamesT Fail Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT Fail Term
f1 NamesT Fail Term -> NamesT Fail Term -> NamesT Fail Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT Fail Term
f2 NamesT Fail Term -> NamesT Fail Term -> NamesT Fail Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> String
-> (NamesT Fail Term -> NamesT Fail Term) -> NamesT Fail Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
lam String
"_" (\ NamesT Fail Term
_ -> NamesT Fail Term
bA NamesT Fail Term -> NamesT Fail Term -> NamesT Fail Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT Fail Term
i NamesT Fail Term -> NamesT Fail Term -> NamesT Fail Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT Fail Term
j) in
                                       NamesT Fail Term -> NamesT Fail Term -> NamesT Fail Term
or NamesT Fail Term
phi (NamesT Fail Term -> NamesT Fail Term
ineg NamesT Fail Term
j NamesT Fail Term -> NamesT Fail Term -> NamesT Fail Term
`imax` NamesT Fail Term
j)
                                          NamesT Fail Term -> NamesT Fail Term -> NamesT Fail Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> String
-> (NamesT Fail Term -> NamesT Fail Term) -> NamesT Fail Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
ilam String
"o" (\ NamesT Fail Term
o -> NamesT Fail Term
u0 NamesT Fail Term
-> (NamesT Fail Term, NamesT Fail Term, NamesT Fail Term)
-> NamesT Fail Term
forall (m :: * -> *).
Applicative m =>
m Term -> (m Term, m Term, m Term) -> m Term
<@@> (NamesT Fail Term
x NamesT Fail Term -> NamesT Fail Term -> NamesT Fail Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> Term -> NamesT Fail Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
iz, NamesT Fail Term
y NamesT Fail Term -> NamesT Fail Term -> NamesT Fail Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> Term -> NamesT Fail Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
iz, NamesT Fail Term
j))
                                          NamesT Fail Term -> NamesT Fail Term -> NamesT Fail Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> (NamesT Fail Term -> NamesT Fail Term -> NamesT Fail Term
or (NamesT Fail Term -> NamesT Fail Term
ineg NamesT Fail Term
j) NamesT Fail Term
j NamesT Fail Term -> NamesT Fail Term -> NamesT Fail Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> String
-> (NamesT Fail Term -> NamesT Fail Term) -> NamesT Fail Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
ilam String
"_" (NamesT Fail Term -> NamesT Fail Term -> NamesT Fail Term
forall a b. a -> b -> a
const (NamesT Fail Term
x NamesT Fail Term -> NamesT Fail Term -> NamesT Fail Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT Fail Term
i))
                                                                  NamesT Fail Term -> NamesT Fail Term -> NamesT Fail Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> String
-> (NamesT Fail Term -> NamesT Fail Term) -> NamesT Fail Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
ilam String
"_" (NamesT Fail Term -> NamesT Fail Term -> NamesT Fail Term
forall a b. a -> b -> a
const (NamesT Fail Term
y NamesT Fail Term -> NamesT Fail Term -> NamesT Fail Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT Fail Term
i))))
                      (NamesT Fail Term
u0 NamesT Fail Term
-> (NamesT Fail Term, NamesT Fail Term, NamesT Fail Term)
-> NamesT Fail Term
forall (m :: * -> *).
Applicative m =>
m Term -> (m Term, m Term, m Term) -> m Term
<@@> (NamesT Fail Term
x NamesT Fail Term -> NamesT Fail Term -> NamesT Fail Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> Term -> NamesT Fail Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
iz, NamesT Fail Term
y NamesT Fail Term -> NamesT Fail Term -> NamesT Fail Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> Term -> NamesT Fail Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
iz, NamesT Fail Term
j))
    compPathP TranspOrHComp
_ Blocked' t (Arg Term)
sphi Maybe (Arg Term)
u Arg Term
a0 FamilyOrNot (Arg Term)
_ FamilyOrNot (Arg Term, Arg Term, Arg Term)
_ = ReduceM (Reduced a' Term)
forall a. HasCallStack => a
__IMPOSSIBLE__
    compId :: TranspOrHComp
-> Blocked' t (Arg Term)
-> Maybe (Arg Term)
-> Arg Term
-> FamilyOrNot (Arg Term)
-> FamilyOrNot (Arg Term, Arg Term, Arg Term)
-> ReduceM (Maybe (Reduced a' Term))
compId TranspOrHComp
cmd Blocked' t (Arg Term)
sphi Maybe (Arg Term)
u Arg Term
a0 FamilyOrNot (Arg Term)
l FamilyOrNot (Arg Term, Arg Term, Arg Term)
bA_x_y = do
      let getTermLocal :: String -> ReduceM Term
getTermLocal = String -> String -> ReduceM Term
forall (m :: * -> *). HasBuiltins m => String -> String -> m Term
getTerm (String -> String -> ReduceM Term)
-> String -> String -> ReduceM Term
forall a b. (a -> b) -> a -> b
$ TranspOrHComp -> String
cmdToName TranspOrHComp
cmd String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" for " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
builtinId
      IntervalView -> Term
unview <- ReduceM (IntervalView -> Term)
forall (m :: * -> *). HasBuiltins m => m (IntervalView -> Term)
intervalUnview'
      Maybe QName
mConId <- String -> ReduceM (Maybe QName)
forall (m :: * -> *). HasBuiltins m => String -> m (Maybe QName)
getBuiltinName' String
builtinConId
      let isConId :: Term -> Bool
isConId (Def QName
q [Elim]
_) = QName -> Maybe QName
forall a. a -> Maybe a
Just QName
q Maybe QName -> Maybe QName -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe QName
mConId
          isConId Term
_         = Bool
False
      Blocked (Arg Term)
sa0 <- Arg Term -> ReduceM (Blocked (Arg Term))
forall t. Reduce t => t -> ReduceM (Blocked t)
reduceB' Arg Term
a0
      -- wasteful to compute b even when cheaper checks might fail
      Bool
b <- case Maybe (Arg Term)
u of
             Maybe (Arg Term)
Nothing -> Bool -> ReduceM Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
             Just Arg Term
u  -> (IntervalView -> Term)
-> Term -> Term -> (Term -> Bool) -> ReduceM Bool
allComponents IntervalView -> Term
unview (Arg Term -> Term
forall e. Arg e -> e
unArg (Arg Term -> Term)
-> (Blocked' t (Arg Term) -> Arg Term)
-> Blocked' t (Arg Term)
-> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Blocked' t (Arg Term) -> Arg Term
forall t a. Blocked' t a -> a
ignoreBlocking (Blocked' t (Arg Term) -> Term) -> Blocked' t (Arg Term) -> Term
forall a b. (a -> b) -> a -> b
$ Blocked' t (Arg Term)
sphi) (Arg Term -> Term
forall e. Arg e -> e
unArg Arg Term
u) Term -> Bool
isConId
      case Maybe QName
mConId of
        Just QName
conid | Term -> Bool
isConId (Arg Term -> Term
forall e. Arg e -> e
unArg (Arg Term -> Term)
-> (Blocked (Arg Term) -> Arg Term) -> Blocked (Arg Term) -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Blocked (Arg Term) -> Arg Term
forall t a. Blocked' t a -> a
ignoreBlocking (Blocked (Arg Term) -> Term) -> Blocked (Arg Term) -> Term
forall a b. (a -> b) -> a -> b
$ Blocked (Arg Term)
sa0) , Bool
b -> (Reduced a' Term -> Maybe (Reduced a' Term)
forall a. a -> Maybe a
Just (Reduced a' Term -> Maybe (Reduced a' Term))
-> ReduceM (Reduced a' Term) -> ReduceM (Maybe (Reduced a' Term))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (ReduceM (Reduced a' Term) -> ReduceM (Maybe (Reduced a' Term)))
-> (ReduceM Term -> ReduceM (Reduced a' Term))
-> ReduceM Term
-> ReduceM (Maybe (Reduced a' Term))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Term -> ReduceM (Reduced a' Term)
forall a a'. a -> ReduceM (Reduced a' a)
redReturn (Term -> ReduceM (Reduced a' Term))
-> ReduceM Term -> ReduceM (Reduced a' Term)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (ReduceM Term -> ReduceM (Maybe (Reduced a' Term)))
-> ReduceM Term -> ReduceM (Maybe (Reduced a' Term))
forall a b. (a -> b) -> a -> b
$ do
          Term
tHComp <- String -> ReduceM Term
getTermLocal String
builtinHComp
          Term
tTrans <- String -> ReduceM Term
getTermLocal String
builtinTrans
          Term
tIMin <- String -> ReduceM Term
getTermLocal String
"primDepIMin"
          Term
tFace <- String -> ReduceM Term
getTermLocal String
"primIdFace"
          Term
tPath <- String -> ReduceM Term
getTermLocal String
"primIdPath"
          Term
tPathType <- String -> ReduceM Term
getTermLocal String
builtinPath
          Names -> NamesT ReduceM Term -> ReduceM Term
forall (m :: * -> *) a. Names -> NamesT m a -> m a
runNamesT [] (NamesT ReduceM Term -> ReduceM Term)
-> NamesT ReduceM Term -> ReduceM Term
forall a b. (a -> b) -> a -> b
$ do
            let io :: NamesT ReduceM Term
io = Term -> NamesT ReduceM Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term -> NamesT ReduceM Term) -> Term -> NamesT ReduceM Term
forall a b. (a -> b) -> a -> b
$ IntervalView -> Term
unview IntervalView
IOne
                iz :: NamesT ReduceM Term
iz = Term -> NamesT ReduceM Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term -> NamesT ReduceM Term) -> Term -> NamesT ReduceM Term
forall a b. (a -> b) -> a -> b
$ IntervalView -> Term
unview IntervalView
IZero
                conId :: NamesT ReduceM Term
conId = Term -> NamesT ReduceM Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term -> NamesT ReduceM Term) -> Term -> NamesT ReduceM Term
forall a b. (a -> b) -> a -> b
$ QName -> [Elim] -> Term
Def QName
conid []
            NamesT ReduceM Term
l <- case FamilyOrNot (Arg Term)
l of
                   IsFam Arg Term
l -> Term -> NamesT ReduceM (NamesT ReduceM Term)
forall (m :: * -> *) a.
(MonadFail m, Subst a) =>
a -> NamesT m (NamesT m a)
open (Term -> NamesT ReduceM (NamesT ReduceM Term))
-> (Arg Term -> Term)
-> Arg Term
-> NamesT ReduceM (NamesT ReduceM Term)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Arg Term -> Term
forall e. Arg e -> e
unArg (Arg Term -> NamesT ReduceM (NamesT ReduceM Term))
-> Arg Term -> NamesT ReduceM (NamesT ReduceM Term)
forall a b. (a -> b) -> a -> b
$ Arg Term
l
                   IsNot Arg Term
l -> do
                     Term -> NamesT ReduceM (NamesT ReduceM Term)
forall (m :: * -> *) a.
(MonadFail m, Subst a) =>
a -> NamesT m (NamesT m a)
open (ArgInfo -> Abs Term -> Term
Lam ArgInfo
defaultArgInfo (Abs Term -> Term) -> Abs Term -> Term
forall a b. (a -> b) -> a -> b
$ String -> Term -> Abs Term
forall a. String -> a -> Abs a
NoAbs String
"_" (Term -> Abs Term) -> Term -> Abs Term
forall a b. (a -> b) -> a -> b
$ Arg Term -> Term
forall e. Arg e -> e
unArg Arg Term
l)
            [NamesT ReduceM Term
p0] <- (Arg Term -> NamesT ReduceM (NamesT ReduceM Term))
-> [Arg Term] -> NamesT ReduceM [NamesT ReduceM Term]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Term -> NamesT ReduceM (NamesT ReduceM Term)
forall (m :: * -> *) a.
(MonadFail m, Subst a) =>
a -> NamesT m (NamesT m a)
open (Term -> NamesT ReduceM (NamesT ReduceM Term))
-> (Arg Term -> Term)
-> Arg Term
-> NamesT ReduceM (NamesT ReduceM Term)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Arg Term -> Term
forall e. Arg e -> e
unArg) [Arg Term
a0]
            NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
p <- case Maybe (Arg Term)
u of
                   Just Arg Term
u -> do
                     NamesT ReduceM Term
u <- Term -> NamesT ReduceM (NamesT ReduceM Term)
forall (m :: * -> *) a.
(MonadFail m, Subst a) =>
a -> NamesT m (NamesT m a)
open (Term -> NamesT ReduceM (NamesT ReduceM Term))
-> (Arg Term -> Term)
-> Arg Term
-> NamesT ReduceM (NamesT ReduceM Term)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Arg Term -> Term
forall e. Arg e -> e
unArg (Arg Term -> NamesT ReduceM (NamesT ReduceM Term))
-> Arg Term -> NamesT ReduceM (NamesT ReduceM Term)
forall a b. (a -> b) -> a -> b
$ Arg Term
u
                     (NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term)
-> NamesT
     ReduceM
     (NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term)
forall (m :: * -> *) a. Monad m => a -> m a
return ((NamesT ReduceM Term
  -> NamesT ReduceM Term -> NamesT ReduceM Term)
 -> NamesT
      ReduceM
      (NamesT ReduceM Term
       -> NamesT ReduceM Term -> NamesT ReduceM Term))
-> (NamesT ReduceM Term
    -> NamesT ReduceM Term -> NamesT ReduceM Term)
-> NamesT
     ReduceM
     (NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term)
forall a b. (a -> b) -> a -> b
$ \ NamesT ReduceM Term
i NamesT ReduceM Term
o -> NamesT ReduceM Term
u NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT ReduceM Term
i NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<..> NamesT ReduceM Term
o
                   Maybe (Arg Term)
Nothing -> do
                     (NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term)
-> NamesT
     ReduceM
     (NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term)
forall (m :: * -> *) a. Monad m => a -> m a
return ((NamesT ReduceM Term
  -> NamesT ReduceM Term -> NamesT ReduceM Term)
 -> NamesT
      ReduceM
      (NamesT ReduceM Term
       -> NamesT ReduceM Term -> NamesT ReduceM Term))
-> (NamesT ReduceM Term
    -> NamesT ReduceM Term -> NamesT ReduceM Term)
-> NamesT
     ReduceM
     (NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term)
forall a b. (a -> b) -> a -> b
$ \ NamesT ReduceM Term
i NamesT ReduceM Term
o -> NamesT ReduceM Term
p0
            NamesT ReduceM Term
phi      <- Term -> NamesT ReduceM (NamesT ReduceM Term)
forall (m :: * -> *) a.
(MonadFail m, Subst a) =>
a -> NamesT m (NamesT m a)
open (Term -> NamesT ReduceM (NamesT ReduceM Term))
-> (Blocked' t (Arg Term) -> Term)
-> Blocked' t (Arg Term)
-> NamesT ReduceM (NamesT ReduceM Term)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Arg Term -> Term
forall e. Arg e -> e
unArg (Arg Term -> Term)
-> (Blocked' t (Arg Term) -> Arg Term)
-> Blocked' t (Arg Term)
-> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Blocked' t (Arg Term) -> Arg Term
forall t a. Blocked' t a -> a
ignoreBlocking (Blocked' t (Arg Term) -> NamesT ReduceM (NamesT ReduceM Term))
-> Blocked' t (Arg Term) -> NamesT ReduceM (NamesT ReduceM Term)
forall a b. (a -> b) -> a -> b
$ Blocked' t (Arg Term)
sphi
            [NamesT ReduceM Term
bA, NamesT ReduceM Term
x, NamesT ReduceM Term
y] <-
              case FamilyOrNot (Arg Term, Arg Term, Arg Term)
bA_x_y of
                IsFam (Arg Term
bA,Arg Term
x,Arg Term
y) -> (Arg Term -> NamesT ReduceM (NamesT ReduceM Term))
-> [Arg Term] -> NamesT ReduceM [NamesT ReduceM Term]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\ Arg Term
a -> Term -> NamesT ReduceM (NamesT ReduceM Term)
forall (m :: * -> *) a.
(MonadFail m, Subst a) =>
a -> NamesT m (NamesT m a)
open (Term -> NamesT ReduceM (NamesT ReduceM Term))
-> (NamesT Fail Term -> Term)
-> NamesT Fail Term
-> NamesT ReduceM (NamesT ReduceM Term)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Names -> NamesT Fail Term -> Term
forall a. Names -> NamesT Fail a -> a
runNames [] (NamesT Fail Term -> NamesT ReduceM (NamesT ReduceM Term))
-> NamesT Fail Term -> NamesT ReduceM (NamesT ReduceM Term)
forall a b. (a -> b) -> a -> b
$ String
-> (NamesT Fail Term -> NamesT Fail Term) -> NamesT Fail Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
lam String
"i" (NamesT Fail Term -> NamesT Fail Term -> NamesT Fail Term
forall a b. a -> b -> a
const (Term -> NamesT Fail Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term -> NamesT Fail Term) -> Term -> NamesT Fail Term
forall a b. (a -> b) -> a -> b
$ Arg Term -> Term
forall e. Arg e -> e
unArg Arg Term
a))) [Arg Term
bA, Arg Term
x, Arg Term
y]
                IsNot (Arg Term
bA,Arg Term
x,Arg Term
y) -> [Arg Term]
-> (Arg Term -> NamesT ReduceM (NamesT ReduceM Term))
-> NamesT ReduceM [NamesT ReduceM Term]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Arg Term
bA,Arg Term
x,Arg Term
y] ((Arg Term -> NamesT ReduceM (NamesT ReduceM Term))
 -> NamesT ReduceM [NamesT ReduceM Term])
-> (Arg Term -> NamesT ReduceM (NamesT ReduceM Term))
-> NamesT ReduceM [NamesT ReduceM Term]
forall a b. (a -> b) -> a -> b
$ \ Arg Term
a -> Term -> NamesT ReduceM (NamesT ReduceM Term)
forall (m :: * -> *) a.
(MonadFail m, Subst a) =>
a -> NamesT m (NamesT m a)
open (ArgInfo -> Abs Term -> Term
Lam ArgInfo
defaultArgInfo (Abs Term -> Term) -> Abs Term -> Term
forall a b. (a -> b) -> a -> b
$ String -> Term -> Abs Term
forall a. String -> a -> Abs a
NoAbs String
"_" (Term -> Abs Term) -> Term -> Abs Term
forall a b. (a -> b) -> a -> b
$ Arg Term -> Term
forall e. Arg e -> e
unArg Arg Term
a)
            let
              eval :: TranspOrHComp
-> NamesT ReduceM Term
-> NamesT ReduceM Term
-> NamesT ReduceM Term
-> NamesT ReduceM Term
-> NamesT ReduceM Term
-> NamesT ReduceM Term
eval TranspOrHComp
DoTransp NamesT ReduceM Term
l NamesT ReduceM Term
bA NamesT ReduceM Term
phi NamesT ReduceM Term
_ NamesT ReduceM Term
u0 = Term -> NamesT ReduceM Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
tTrans NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> NamesT ReduceM Term
l NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT ReduceM Term
bA NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT ReduceM Term
phi NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT ReduceM Term
u0
              eval TranspOrHComp
DoHComp NamesT ReduceM Term
l NamesT ReduceM Term
bA NamesT ReduceM Term
phi NamesT ReduceM Term
u NamesT ReduceM Term
u0 = Term -> NamesT ReduceM Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
tHComp NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> (NamesT ReduceM Term
l NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT ReduceM Term
io) NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> (NamesT ReduceM Term
bA NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT ReduceM Term
io) NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> NamesT ReduceM Term
phi
                                                       NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT ReduceM Term
u NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT ReduceM Term
u0
            NamesT ReduceM Term
conId NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> (NamesT ReduceM Term
l NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT ReduceM Term
io) NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> (NamesT ReduceM Term
bA NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT ReduceM Term
io) NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> (NamesT ReduceM Term
x NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT ReduceM Term
io) NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> (NamesT ReduceM Term
y NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT ReduceM Term
io)
                  NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> (Term -> NamesT ReduceM Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
tIMin NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT ReduceM Term
phi
                                  NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> String
-> (NamesT ReduceM Term -> NamesT ReduceM Term)
-> NamesT ReduceM Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
ilam String
"o" (\ NamesT ReduceM Term
o -> Term -> NamesT ReduceM Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
tFace NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> (NamesT ReduceM Term
l NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT ReduceM Term
io) NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> (NamesT ReduceM Term
bA NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT ReduceM Term
io) NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> (NamesT ReduceM Term
x NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT ReduceM Term
io) NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> (NamesT ReduceM Term
y NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT ReduceM Term
io)
                                                                   NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> (NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
p NamesT ReduceM Term
io NamesT ReduceM Term
o)))
                  NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> (TranspOrHComp
-> NamesT ReduceM Term
-> NamesT ReduceM Term
-> NamesT ReduceM Term
-> NamesT ReduceM Term
-> NamesT ReduceM Term
-> NamesT ReduceM Term
eval TranspOrHComp
cmd NamesT ReduceM Term
l
                                (String
-> (NamesT ReduceM Term -> NamesT ReduceM Term)
-> NamesT ReduceM Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
lam String
"i" ((NamesT ReduceM Term -> NamesT ReduceM Term)
 -> NamesT ReduceM Term)
-> (NamesT ReduceM Term -> NamesT ReduceM Term)
-> NamesT ReduceM Term
forall a b. (a -> b) -> a -> b
$ \ NamesT ReduceM Term
i -> Term -> NamesT ReduceM Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
tPathType NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> (NamesT ReduceM Term
l NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT ReduceM Term
i) NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> (NamesT ReduceM Term
bA NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT ReduceM Term
i) NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> (NamesT ReduceM Term
x NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT ReduceM Term
i) NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> (NamesT ReduceM Term
y NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT ReduceM Term
i))
                                NamesT ReduceM Term
phi
                                (String
-> (NamesT ReduceM Term -> NamesT ReduceM Term)
-> NamesT ReduceM Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
lam String
"i" ((NamesT ReduceM Term -> NamesT ReduceM Term)
 -> NamesT ReduceM Term)
-> (NamesT ReduceM Term -> NamesT ReduceM Term)
-> NamesT ReduceM Term
forall a b. (a -> b) -> a -> b
$ \ NamesT ReduceM Term
i -> String
-> (NamesT ReduceM Term -> NamesT ReduceM Term)
-> NamesT ReduceM Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
ilam String
"o" ((NamesT ReduceM Term -> NamesT ReduceM Term)
 -> NamesT ReduceM Term)
-> (NamesT ReduceM Term -> NamesT ReduceM Term)
-> NamesT ReduceM Term
forall a b. (a -> b) -> a -> b
$ \ NamesT ReduceM Term
o -> Term -> NamesT ReduceM Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
tPath NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> (NamesT ReduceM Term
l NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT ReduceM Term
i) NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> (NamesT ReduceM Term
bA NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT ReduceM Term
i)
                                                                                    NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> (NamesT ReduceM Term
x NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT ReduceM Term
i) NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> (NamesT ReduceM Term
y NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT ReduceM Term
i)
                                                                                    NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> (NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
p NamesT ReduceM Term
i NamesT ReduceM Term
o)
                                      )
                                (Term -> NamesT ReduceM Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
tPath NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> (NamesT ReduceM Term
l NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT ReduceM Term
iz) NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> (NamesT ReduceM Term
bA NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT ReduceM Term
iz) NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> (NamesT ReduceM Term
x NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT ReduceM Term
iz) NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> (NamesT ReduceM Term
y NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT ReduceM Term
iz)
                                                  NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT ReduceM Term
p0)
                      )
        Maybe QName
_ -> Maybe (Reduced a' Term) -> ReduceM (Maybe (Reduced a' Term))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Reduced a' Term) -> ReduceM (Maybe (Reduced a' Term)))
-> Maybe (Reduced a' Term) -> ReduceM (Maybe (Reduced a' Term))
forall a b. (a -> b) -> a -> b
$ Maybe (Reduced a' Term)
forall a. Maybe a
Nothing
    allComponents :: (IntervalView -> Term)
-> Term -> Term -> (Term -> Bool) -> ReduceM Bool
allComponents IntervalView -> Term
unview Term
phi Term
u Term -> Bool
p = do
            let
              boolToI :: Bool -> Term
boolToI Bool
b = if Bool
b then IntervalView -> Term
unview IntervalView
IOne else IntervalView -> Term
unview IntervalView
IZero
            [(Map Arity Bool, [Term])]
as <- Term -> ReduceM [(Map Arity Bool, [Term])]
forall (m :: * -> *).
HasBuiltins m =>
Term -> m [(Map Arity Bool, [Term])]
decomposeInterval Term
phi
            [ReduceM Bool] -> ReduceM Bool
forall (f :: * -> *) (m :: * -> *).
(Foldable f, Monad m) =>
f (m Bool) -> m Bool
andM ([ReduceM Bool] -> ReduceM Bool)
-> (((Map Arity Bool, [Term]) -> ReduceM Bool) -> [ReduceM Bool])
-> ((Map Arity Bool, [Term]) -> ReduceM Bool)
-> ReduceM Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Map Arity Bool, [Term])]
-> ((Map Arity Bool, [Term]) -> ReduceM Bool) -> [ReduceM Bool]
forall (m :: * -> *) a b. Functor m => m a -> (a -> b) -> m b
for [(Map Arity Bool, [Term])]
as (((Map Arity Bool, [Term]) -> ReduceM Bool) -> ReduceM Bool)
-> ((Map Arity Bool, [Term]) -> ReduceM Bool) -> ReduceM Bool
forall a b. (a -> b) -> a -> b
$ \ (Map Arity Bool
bs,[Term]
ts) -> do
                 let u' :: Term
u' = [(Arity, Term)] -> Substitution' Term
forall a. EndoSubst a => [(Arity, a)] -> Substitution' a
listS (Map Arity Term -> [(Arity, Term)]
forall k a. Map k a -> [(k, a)]
Map.toAscList (Map Arity Term -> [(Arity, Term)])
-> Map Arity Term -> [(Arity, Term)]
forall a b. (a -> b) -> a -> b
$ (Bool -> Term) -> Map Arity Bool -> Map Arity Term
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map Bool -> Term
boolToI Map Arity Bool
bs) Substitution' (SubstArg Term) -> Term -> Term
forall a. Subst a => Substitution' (SubstArg a) -> a -> a
`applySubst` Term
u
                 Blocked' Term Term
t <- Term -> ReduceM (Blocked' Term Term)
reduce2Lam Term
u'
                 Bool -> ReduceM Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> ReduceM Bool) -> Bool -> ReduceM Bool
forall a b. (a -> b) -> a -> b
$! Term -> Bool
p (Term -> Bool) -> Term -> Bool
forall a b. (a -> b) -> a -> b
$ Blocked' Term Term -> Term
forall t a. Blocked' t a -> a
ignoreBlocking Blocked' Term Term
t
    reduce2Lam :: Term -> ReduceM (Blocked' Term Term)
reduce2Lam Term
t = do
          Term
t <- Term -> ReduceM Term
forall t. Reduce t => t -> ReduceM t
reduce' Term
t
          case Term -> Abs Term
lam2Abs Term
t of
            Abs Term
t -> Abs Term
-> (Term -> ReduceM (Blocked' Term Term))
-> ReduceM (Blocked' Term Term)
forall a (m :: * -> *) b.
(Subst a, MonadAddContext m) =>
Abs a -> (a -> m b) -> m b
underAbstraction_ Abs Term
t ((Term -> ReduceM (Blocked' Term Term))
 -> ReduceM (Blocked' Term Term))
-> (Term -> ReduceM (Blocked' Term Term))
-> ReduceM (Blocked' Term Term)
forall a b. (a -> b) -> a -> b
$ \ Term
t -> do
               Term
t <- Term -> ReduceM Term
forall t. Reduce t => t -> ReduceM t
reduce' Term
t
               case Term -> Abs Term
lam2Abs Term
t of
                 Abs Term
t -> Abs Term
-> (Term -> ReduceM (Blocked' Term Term))
-> ReduceM (Blocked' Term Term)
forall a (m :: * -> *) b.
(Subst a, MonadAddContext m) =>
Abs a -> (a -> m b) -> m b
underAbstraction_ Abs Term
t Term -> ReduceM (Blocked' Term Term)
forall t. Reduce t => t -> ReduceM (Blocked t)
reduceB'
         where
           lam2Abs :: Term -> Abs Term
lam2Abs (Lam ArgInfo
_ Abs Term
t) = Abs Term -> Term
forall a. Subst a => Abs a -> a
absBody Abs Term
t Term -> Abs Term -> Abs Term
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Abs Term
t
           lam2Abs Term
t         = String -> Term -> Abs Term
forall a. String -> a -> Abs a
Abs String
"y" (Arity -> Term -> Term
forall a. Subst a => Arity -> a -> a
raise Arity
1 Term
t Term -> [Arg Term] -> Term
forall t. Apply t => t -> [Arg Term] -> t
`apply` [Term -> Arg Term
forall e. e -> Arg e
argN (Term -> Arg Term) -> Term -> Arg Term
forall a b. (a -> b) -> a -> b
$ Arity -> Term
var Arity
0])
    allComponentsBack :: (IntervalView -> Term)
-> Term
-> Term
-> (Term -> a)
-> ReduceM ([a], [Maybe (Blocked' Term Term, Map Arity Bool)])
allComponentsBack IntervalView -> Term
unview Term
phi Term
u Term -> a
p = do
            let
              boolToI :: Bool -> Term
boolToI Bool
b = if Bool
b then IntervalView -> Term
unview IntervalView
IOne else IntervalView -> Term
unview IntervalView
IZero
              lamlam :: Term -> Term
lamlam Term
t = ArgInfo -> Abs Term -> Term
Lam ArgInfo
defaultArgInfo (String -> Term -> Abs Term
forall a. String -> a -> Abs a
Abs String
"i" (ArgInfo -> Abs Term -> Term
Lam (Relevance -> ArgInfo -> ArgInfo
forall a. LensRelevance a => Relevance -> a -> a
setRelevance Relevance
Irrelevant ArgInfo
defaultArgInfo) (String -> Term -> Abs Term
forall a. String -> a -> Abs a
Abs String
"o" Term
t)))
            [(Map Arity Bool, [Term])]
as <- Term -> ReduceM [(Map Arity Bool, [Term])]
forall (m :: * -> *).
HasBuiltins m =>
Term -> m [(Map Arity Bool, [Term])]
decomposeInterval Term
phi
            ([a]
flags,[Maybe (Blocked' Term Term, Map Arity Bool)]
t_alphas) <- ([(a, Maybe (Blocked' Term Term, Map Arity Bool))]
 -> ([a], [Maybe (Blocked' Term Term, Map Arity Bool)]))
-> ReduceM [(a, Maybe (Blocked' Term Term, Map Arity Bool))]
-> ReduceM ([a], [Maybe (Blocked' Term Term, Map Arity Bool)])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(a, Maybe (Blocked' Term Term, Map Arity Bool))]
-> ([a], [Maybe (Blocked' Term Term, Map Arity Bool)])
forall a b. [(a, b)] -> ([a], [b])
unzip (ReduceM [(a, Maybe (Blocked' Term Term, Map Arity Bool))]
 -> ReduceM ([a], [Maybe (Blocked' Term Term, Map Arity Bool)]))
-> (((Map Arity Bool, [Term])
     -> ReduceM (a, Maybe (Blocked' Term Term, Map Arity Bool)))
    -> ReduceM [(a, Maybe (Blocked' Term Term, Map Arity Bool))])
-> ((Map Arity Bool, [Term])
    -> ReduceM (a, Maybe (Blocked' Term Term, Map Arity Bool)))
-> ReduceM ([a], [Maybe (Blocked' Term Term, Map Arity Bool)])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Map Arity Bool, [Term])]
-> ((Map Arity Bool, [Term])
    -> ReduceM (a, Maybe (Blocked' Term Term, Map Arity Bool)))
-> ReduceM [(a, Maybe (Blocked' Term Term, Map Arity Bool))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [(Map Arity Bool, [Term])]
as (((Map Arity Bool, [Term])
  -> ReduceM (a, Maybe (Blocked' Term Term, Map Arity Bool)))
 -> ReduceM ([a], [Maybe (Blocked' Term Term, Map Arity Bool)]))
-> ((Map Arity Bool, [Term])
    -> ReduceM (a, Maybe (Blocked' Term Term, Map Arity Bool)))
-> ReduceM ([a], [Maybe (Blocked' Term Term, Map Arity Bool)])
forall a b. (a -> b) -> a -> b
$ \ (Map Arity Bool
bs,[Term]
ts) -> do
                 let u' :: Term
u' = [(Arity, Term)] -> Substitution' Term
forall a. EndoSubst a => [(Arity, a)] -> Substitution' a
listS [(Arity, Term)]
bs' Substitution' (SubstArg Term) -> Term -> Term
forall a. Subst a => Substitution' (SubstArg a) -> a -> a
`applySubst` Term
u
                     bs' :: [(Arity, Term)]
bs' = (Map Arity Term -> [(Arity, Term)]
forall k a. Map k a -> [(k, a)]
Map.toAscList (Map Arity Term -> [(Arity, Term)])
-> Map Arity Term -> [(Arity, Term)]
forall a b. (a -> b) -> a -> b
$ (Bool -> Term) -> Map Arity Bool -> Map Arity Term
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map Bool -> Term
boolToI Map Arity Bool
bs)
                     -- Γ₁, i : I, Γ₂, j : I, Γ₃  ⊢ weaken : Γ₁, Γ₂, Γ₃   for bs' = [(j,_),(i,_)]
                     -- ordering of "j,i,.." matters.
                 let weaken :: Substitution' Term
weaken = (Arity -> Substitution' Term -> Substitution' Term)
-> Substitution' Term -> [Arity] -> Substitution' Term
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\ Arity
j Substitution' Term
s -> Substitution' Term
s Substitution' Term -> Substitution' Term -> Substitution' Term
forall a.
EndoSubst a =>
Substitution' a -> Substitution' a -> Substitution' a
`composeS` Arity -> Arity -> Substitution' Term
forall a. Arity -> Arity -> Substitution' a
raiseFromS Arity
j Arity
1) Substitution' Term
forall a. Substitution' a
idS (((Arity, Term) -> Arity) -> [(Arity, Term)] -> [Arity]
forall a b. (a -> b) -> [a] -> [b]
map (Arity, Term) -> Arity
forall a b. (a, b) -> a
fst [(Arity, Term)]
bs')
                 Blocked' Term Term
t <- Term -> ReduceM (Blocked' Term Term)
reduce2Lam Term
u'
                 (a, Maybe (Blocked' Term Term, Map Arity Bool))
-> ReduceM (a, Maybe (Blocked' Term Term, Map Arity Bool))
forall (m :: * -> *) a. Monad m => a -> m a
return ((a, Maybe (Blocked' Term Term, Map Arity Bool))
 -> ReduceM (a, Maybe (Blocked' Term Term, Map Arity Bool)))
-> (a, Maybe (Blocked' Term Term, Map Arity Bool))
-> ReduceM (a, Maybe (Blocked' Term Term, Map Arity Bool))
forall a b. (a -> b) -> a -> b
$ (Term -> a
p (Term -> a) -> Term -> a
forall a b. (a -> b) -> a -> b
$ Blocked' Term Term -> Term
forall t a. Blocked' t a -> a
ignoreBlocking Blocked' Term Term
t, [(Blocked' Term Term, Map Arity Bool)]
-> Maybe (Blocked' Term Term, Map Arity Bool)
forall a. [a] -> Maybe a
listToMaybe [ (Substitution' Term
Substitution' (SubstArg (Blocked' Term Term))
weaken Substitution' (SubstArg (Blocked' Term Term))
-> Blocked' Term Term -> Blocked' Term Term
forall a. Subst a => Substitution' (SubstArg a) -> a -> a
`applySubst` (Term -> Term
lamlam (Term -> Term) -> Blocked' Term Term -> Blocked' Term Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Blocked' Term Term
t),Map Arity Bool
bs) | [Term] -> Bool
forall a. Null a => a -> Bool
null [Term]
ts ])
            ([a], [Maybe (Blocked' Term Term, Map Arity Bool)])
-> ReduceM ([a], [Maybe (Blocked' Term Term, Map Arity Bool)])
forall (m :: * -> *) a. Monad m => a -> m a
return (([a], [Maybe (Blocked' Term Term, Map Arity Bool)])
 -> ReduceM ([a], [Maybe (Blocked' Term Term, Map Arity Bool)]))
-> ([a], [Maybe (Blocked' Term Term, Map Arity Bool)])
-> ReduceM ([a], [Maybe (Blocked' Term Term, Map Arity Bool)])
forall a b. (a -> b) -> a -> b
$ ([a]
flags,[Maybe (Blocked' Term Term, Map Arity Bool)]
t_alphas)
    compData :: Bool
-> a
-> TranspOrHComp
-> FamilyOrNot (Arg Term)
-> FamilyOrNot [Arg Term]
-> Blocked (FamilyOrNot (Arg Term))
-> Blocked (Arg Term)
-> Maybe (Arg Term)
-> Arg Term
-> ReduceM (Reduced MaybeReducedArgs Term)
compData Bool
False a
_ cmd :: TranspOrHComp
cmd@TranspOrHComp
DoHComp (IsNot Arg Term
l) (IsNot [Arg Term]
ps) Blocked (FamilyOrNot (Arg Term))
fsc Blocked (Arg Term)
sphi (Just Arg Term
u) Arg Term
a0 = do
      let getTermLocal :: String -> ReduceM Term
getTermLocal = String -> String -> ReduceM Term
forall (m :: * -> *). HasBuiltins m => String -> String -> m Term
getTerm (String -> String -> ReduceM Term)
-> String -> String -> ReduceM Term
forall a b. (a -> b) -> a -> b
$ TranspOrHComp -> String
cmdToName TranspOrHComp
cmd String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" for data types"

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

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

            if Maybe ConHead -> Bool
forall a. Maybe a -> Bool
isJust Maybe ConHead
h Bool -> Bool -> Bool
&& [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and [Bool]
hd then ConHead
-> Blocked (Arg Term) -> ReduceM (Reduced MaybeReducedArgs Term)
k (ConHead -> Maybe ConHead -> ConHead
forall a. a -> Maybe a -> a
fromMaybe ConHead
forall a. HasCallStack => a
__IMPOSSIBLE__ Maybe ConHead
h) Blocked (Arg Term)
su
                      else Blocked (Arg Term) -> ReduceM (Reduced MaybeReducedArgs Term)
noRed' Blocked (Arg Term)
su

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

    compData Bool
_     a
0 TranspOrHComp
DoTransp (IsFam Arg Term
l) (IsFam [Arg Term]
ps) Blocked (FamilyOrNot (Arg Term))
fsc Blocked (Arg Term)
sphi Maybe (Arg Term)
Nothing Arg Term
a0 = Term -> ReduceM (Reduced MaybeReducedArgs Term)
forall a a'. a -> ReduceM (Reduced a' a)
redReturn (Term -> ReduceM (Reduced MaybeReducedArgs Term))
-> Term -> ReduceM (Reduced MaybeReducedArgs Term)
forall a b. (a -> b) -> a -> b
$ Arg Term -> Term
forall e. Arg e -> e
unArg Arg Term
a0
    compData Bool
isHIT a
_ cmd :: TranspOrHComp
cmd@TranspOrHComp
DoTransp (IsFam Arg Term
l) (IsFam [Arg Term]
ps) Blocked (FamilyOrNot (Arg Term))
fsc Blocked (Arg Term)
sphi Maybe (Arg Term)
Nothing Arg Term
a0 = do
      let getTermLocal :: String -> ReduceM Term
getTermLocal = String -> String -> ReduceM Term
forall (m :: * -> *). HasBuiltins m => String -> String -> m Term
getTerm (String -> String -> ReduceM Term)
-> String -> String -> ReduceM Term
forall a b. (a -> b) -> a -> b
$ TranspOrHComp -> String
cmdToName TranspOrHComp
cmd String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" for data types"
      let sc :: Blocked (Arg Term)
sc = FamilyOrNot (Arg Term) -> Arg Term
forall a. FamilyOrNot a -> a
famThing (FamilyOrNot (Arg Term) -> Arg Term)
-> Blocked (FamilyOrNot (Arg Term)) -> Blocked (Arg Term)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Blocked (FamilyOrNot (Arg Term))
fsc
      Maybe QName
mhcompName <- String -> ReduceM (Maybe QName)
forall (m :: * -> *). HasBuiltins m => String -> m (Maybe QName)
getName' String
builtinHComp
      Term -> Term
constrForm <- do
        Maybe Term
mz <- String -> ReduceM (Maybe Term)
forall (m :: * -> *). HasBuiltins m => String -> m (Maybe Term)
getTerm' String
builtinZero
        Maybe Term
ms <- String -> ReduceM (Maybe Term)
forall (m :: * -> *). HasBuiltins m => String -> m (Maybe Term)
getTerm' String
builtinSuc
        (Term -> Term) -> ReduceM (Term -> Term)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Term -> Term) -> ReduceM (Term -> Term))
-> (Term -> Term) -> ReduceM (Term -> Term)
forall a b. (a -> b) -> a -> b
$ \ Term
t -> Term -> Maybe Term -> Term
forall a. a -> Maybe a -> a
fromMaybe Term
t (Maybe Term -> Maybe Term -> Term -> Maybe Term
forall (m :: * -> *).
Applicative m =>
m Term -> m Term -> Term -> m Term
constructorForm' Maybe Term
mz Maybe Term
ms Term
t)
      Blocked (Arg Term)
sa0 <- Arg Term -> ReduceM (Blocked (Arg Term))
forall t. Reduce t => t -> ReduceM (Blocked t)
reduceB' Arg Term
a0
      let f :: Blocked' t (Arg c) -> c
f = Arg c -> c
forall e. Arg e -> e
unArg (Arg c -> c)
-> (Blocked' t (Arg c) -> Arg c) -> Blocked' t (Arg c) -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Blocked' t (Arg c) -> Arg c
forall t a. Blocked' t a -> a
ignoreBlocking
          phi :: Term
phi = Blocked (Arg Term) -> Term
forall t c. Blocked' t (Arg c) -> c
f Blocked (Arg Term)
sphi
          a0 :: Term
a0 = Blocked (Arg Term) -> Term
forall t c. Blocked' t (Arg c) -> c
f Blocked (Arg Term)
sa0
          noRed :: ReduceM (Reduced MaybeReducedArgs Term)
noRed = Reduced MaybeReducedArgs Term
-> ReduceM (Reduced MaybeReducedArgs Term)
forall (m :: * -> *) a. Monad m => a -> m a
return (Reduced MaybeReducedArgs Term
 -> ReduceM (Reduced MaybeReducedArgs Term))
-> Reduced MaybeReducedArgs Term
-> ReduceM (Reduced MaybeReducedArgs Term)
forall a b. (a -> b) -> a -> b
$ MaybeReducedArgs -> Reduced MaybeReducedArgs Term
forall no yes. no -> Reduced no yes
NoReduction [Arg Term -> MaybeReduced (Arg Term)
forall a. a -> MaybeReduced a
notReduced Arg Term
l,Blocked (Arg Term) -> MaybeReduced (Arg Term)
reduced Blocked (Arg Term)
sc, Blocked (Arg Term) -> MaybeReduced (Arg Term)
reduced Blocked (Arg Term)
sphi, Blocked (Arg Term) -> MaybeReduced (Arg Term)
reduced Blocked (Arg Term)
sa0]
      let lam_i :: Term -> Term
lam_i = ArgInfo -> Abs Term -> Term
Lam ArgInfo
defaultArgInfo (Abs Term -> Term) -> (Term -> Abs Term) -> Term -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Term -> Abs Term
forall a. String -> a -> Abs a
Abs String
"i"
      case Term -> Term
constrForm Term
a0 of
        Con ConHead
h ConInfo
_ [Elim]
args -> do
          Constructor{ conComp :: Defn -> CompKit
conComp = CompKit
cm } <- Definition -> Defn
theDef (Definition -> Defn) -> ReduceM Definition -> ReduceM Defn
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> QName -> ReduceM Definition
forall (m :: * -> *). HasConstInfo m => QName -> m Definition
getConstInfo (ConHead -> QName
conName ConHead
h)
          case CompKit -> Maybe QName
nameOfTransp CompKit
cm of
              Just QName
transpD -> Term -> ReduceM (Reduced MaybeReducedArgs Term)
forall a a'. a -> ReduceM (Reduced a' a)
redReturn (Term -> ReduceM (Reduced MaybeReducedArgs Term))
-> Term -> ReduceM (Reduced MaybeReducedArgs Term)
forall a b. (a -> b) -> a -> b
$ QName -> [Elim] -> Term
Def QName
transpD [] Term -> [Arg Term] -> Term
forall t. Apply t => t -> [Arg Term] -> t
`apply`
                                          ((Arg Term -> Arg Term) -> [Arg Term] -> [Arg Term]
forall a b. (a -> b) -> [a] -> [b]
map ((Term -> Term) -> Arg Term -> Arg Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Term -> Term
lam_i) [Arg Term]
ps [Arg Term] -> [Arg Term] -> [Arg Term]
forall a. [a] -> [a] -> [a]
++ (Term -> Arg Term) -> [Term] -> [Arg Term]
forall a b. (a -> b) -> [a] -> [b]
map Term -> Arg Term
forall e. e -> Arg e
argN [Term
phi,Term
a0])
              Maybe QName
Nothing        -> ReduceM (Reduced MaybeReducedArgs Term)
noRed
        Def QName
q [Elim]
es | Bool
isHIT, QName -> Maybe QName
forall a. a -> Maybe a
Just QName
q Maybe QName -> Maybe QName -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe QName
mhcompName, Just [Arg Term
_l0,Arg Term
_c0,Arg Term
psi,Arg Term
u,Arg Term
u0] <- [Elim] -> Maybe [Arg Term]
forall a. [Elim' a] -> Maybe [Arg a]
allApplyElims [Elim]
es -> do
           let bC :: Arg Term
bC = Blocked (Arg Term) -> Arg Term
forall t a. Blocked' t a -> a
ignoreBlocking Blocked (Arg Term)
sc
           Term
hcomp <- String -> ReduceM Term
getTermLocal String
builtinHComp
           Term
transp <- String -> ReduceM Term
getTermLocal String
builtinTrans
           Term
io <- String -> ReduceM Term
getTermLocal String
builtinIOne
           Term
iz <- String -> ReduceM Term
getTermLocal String
builtinIZero
           Term -> ReduceM (Reduced MaybeReducedArgs Term)
forall a a'. a -> ReduceM (Reduced a' a)
redReturn (Term -> ReduceM (Reduced MaybeReducedArgs Term))
-> (NamesT ReduceM Term -> ReduceM Term)
-> NamesT ReduceM Term
-> ReduceM (Reduced MaybeReducedArgs Term)
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Names -> NamesT ReduceM Term -> ReduceM Term
forall (m :: * -> *) a. Names -> NamesT m a -> m a
runNamesT [] (NamesT ReduceM Term -> ReduceM (Reduced MaybeReducedArgs Term))
-> NamesT ReduceM Term -> ReduceM (Reduced MaybeReducedArgs Term)
forall a b. (a -> b) -> a -> b
$ do
             [NamesT ReduceM Term
l,NamesT ReduceM Term
bC,NamesT ReduceM Term
phi,NamesT ReduceM Term
psi,NamesT ReduceM Term
u,NamesT ReduceM Term
u0] <- (Arg Term -> NamesT ReduceM (NamesT ReduceM Term))
-> [Arg Term] -> NamesT ReduceM [NamesT ReduceM Term]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Term -> NamesT ReduceM (NamesT ReduceM Term)
forall (m :: * -> *) a.
(MonadFail m, Subst a) =>
a -> NamesT m (NamesT m a)
open (Term -> NamesT ReduceM (NamesT ReduceM Term))
-> (Arg Term -> Term)
-> Arg Term
-> NamesT ReduceM (NamesT ReduceM Term)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Arg Term -> Term
forall e. Arg e -> e
unArg) [Arg Term
l,Arg Term
bC,Blocked (Arg Term) -> Arg Term
forall t a. Blocked' t a -> a
ignoreBlocking Blocked (Arg Term)
sphi,Arg Term
psi,Arg Term
u,Arg Term
u0]
             -- hcomp (sc 1) [psi |-> transp sc phi u] (transp sc phi u0)
             Term -> NamesT ReduceM Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
hcomp NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> (NamesT ReduceM Term
l NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> Term -> NamesT ReduceM Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
io) NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> (NamesT ReduceM Term
bC NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> Term -> NamesT ReduceM Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
io) NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> NamesT ReduceM Term
psi
                   NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> String
-> (NamesT ReduceM Term -> NamesT ReduceM Term)
-> NamesT ReduceM Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
lam String
"j" (\ NamesT ReduceM Term
j -> String
-> (NamesT ReduceM Term -> NamesT ReduceM Term)
-> NamesT ReduceM Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
ilam String
"o" ((NamesT ReduceM Term -> NamesT ReduceM Term)
 -> NamesT ReduceM Term)
-> (NamesT ReduceM Term -> NamesT ReduceM Term)
-> NamesT ReduceM Term
forall a b. (a -> b) -> a -> b
$ \ NamesT ReduceM Term
o ->
                        Term -> NamesT ReduceM Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
transp NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> NamesT ReduceM Term
l NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT ReduceM Term
bC NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT ReduceM Term
phi NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> (NamesT ReduceM Term
u NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT ReduceM Term
j NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<..> NamesT ReduceM Term
o))
                   NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> (Term -> NamesT ReduceM Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
transp NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> NamesT ReduceM Term
l NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT ReduceM Term
bC NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT ReduceM Term
phi NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT ReduceM Term
u0)
        Term
_ -> ReduceM (Reduced MaybeReducedArgs Term)
noRed
    compData Bool
_ a
_ TranspOrHComp
_ FamilyOrNot (Arg Term)
_ FamilyOrNot [Arg Term]
_ Blocked (FamilyOrNot (Arg Term))
_ Blocked (Arg Term)
_ Maybe (Arg Term)
_ Arg Term
_ = ReduceM (Reduced MaybeReducedArgs Term)
forall a. HasCallStack => a
__IMPOSSIBLE__

primComp :: TCM PrimitiveImpl
primComp :: TCM PrimitiveImpl
primComp = do
  Cubical -> String -> TCM ()
requireCubical Cubical
CErased String
""
  Type
t    <- Names -> NamesT (TCMT IO) Type -> TCMT IO Type
forall (m :: * -> *) a. Names -> NamesT m a -> m a
runNamesT [] (NamesT (TCMT IO) Type -> TCMT IO Type)
-> NamesT (TCMT IO) Type -> TCMT IO Type
forall a b. (a -> b) -> a -> b
$
          String
-> NamesT (TCMT IO) Type
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall (m :: * -> *).
(MonadFail m, MonadAddContext m, MonadDebug m) =>
String
-> NamesT m Type
-> (NamesT m Term -> NamesT m Type)
-> NamesT m Type
hPi' String
"a" (NamesT (TCMT IO) Type
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Type
primIntervalType NamesT (TCMT IO) Type
-> NamesT (TCMT IO) Type -> NamesT (TCMT IO) Type
forall (m :: * -> *). Applicative m => m Type -> m Type -> m Type
--> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
forall (m :: * -> *). Functor m => m Term -> m Type
el (TCMT IO Term -> NamesT (TCMT IO) Term
forall (m :: * -> *) a. Monad m => m a -> NamesT m a
cl TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primLevel)) ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
 -> NamesT (TCMT IO) Type)
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall a b. (a -> b) -> a -> b
$ \ NamesT (TCMT IO) Term
a ->
          String
-> NamesT (TCMT IO) Type
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall (m :: * -> *).
(MonadFail m, MonadAddContext m, MonadDebug m) =>
String
-> NamesT m Type
-> (NamesT m Term -> NamesT m Type)
-> NamesT m Type
nPi' String
"A" (String
-> NamesT (TCMT IO) Type
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall (m :: * -> *).
(MonadFail m, MonadAddContext m, MonadDebug m) =>
String
-> NamesT m Type
-> (NamesT m Term -> NamesT m Type)
-> NamesT m Type
nPi' String
"i" NamesT (TCMT IO) Type
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Type
primIntervalType ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
 -> NamesT (TCMT IO) Type)
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall a b. (a -> b) -> a -> b
$ \ NamesT (TCMT IO) Term
i -> (Sort' Term -> Type
sort (Sort' Term -> Type) -> (Term -> Sort' Term) -> Term -> Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term -> Sort' Term
tmSort (Term -> Type) -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (NamesT (TCMT IO) Term
a NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT (TCMT IO) Term
i))) ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
 -> NamesT (TCMT IO) Type)
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall a b. (a -> b) -> a -> b
$ \ NamesT (TCMT IO) Term
bA ->
          String
-> NamesT (TCMT IO) Type
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall (m :: * -> *).
(MonadFail m, MonadAddContext m, MonadDebug m) =>
String
-> NamesT m Type
-> (NamesT m Term -> NamesT m Type)
-> NamesT m Type
hPi' String
"φ" NamesT (TCMT IO) Type
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Type
primIntervalType ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
 -> NamesT (TCMT IO) Type)
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall a b. (a -> b) -> a -> b
$ \ NamesT (TCMT IO) Term
phi ->
          String
-> NamesT (TCMT IO) Type
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall (m :: * -> *).
(MonadFail m, MonadAddContext m, MonadDebug m) =>
String
-> NamesT m Type
-> (NamesT m Term -> NamesT m Type)
-> NamesT m Type
nPi' String
"i" NamesT (TCMT IO) Type
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Type
primIntervalType (\ NamesT (TCMT IO) Term
i -> String
-> NamesT (TCMT IO) Term
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall (m :: * -> *).
(MonadAddContext m, HasBuiltins m, MonadDebug m) =>
String
-> NamesT m Term
-> (NamesT m Term -> NamesT m Type)
-> NamesT m Type
pPi' String
"o" NamesT (TCMT IO) Term
phi ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
 -> NamesT (TCMT IO) Type)
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall a b. (a -> b) -> a -> b
$ \ NamesT (TCMT IO) Term
_ -> NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Type
el' (NamesT (TCMT IO) Term
a NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT (TCMT IO) Term
i) (NamesT (TCMT IO) Term
bA NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT (TCMT IO) Term
i)) NamesT (TCMT IO) Type
-> NamesT (TCMT IO) Type -> NamesT (TCMT IO) Type
forall (m :: * -> *). Applicative m => m Type -> m Type -> m Type
-->
          (NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Type
el' (NamesT (TCMT IO) Term
a NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> TCMT IO Term -> NamesT (TCMT IO) Term
forall (m :: * -> *) a. Monad m => m a -> NamesT m a
cl TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primIZero) (NamesT (TCMT IO) Term
bA NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> TCMT IO Term -> NamesT (TCMT IO) Term
forall (m :: * -> *) a. Monad m => m a -> NamesT m a
cl TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primIZero) NamesT (TCMT IO) Type
-> NamesT (TCMT IO) Type -> NamesT (TCMT IO) Type
forall (m :: * -> *). Applicative m => m Type -> m Type -> m Type
--> NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Type
el' (NamesT (TCMT IO) Term
a NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> TCMT IO Term -> NamesT (TCMT IO) Term
forall (m :: * -> *) a. Monad m => m a -> NamesT m a
cl TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primIOne) (NamesT (TCMT IO) Term
bA NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> TCMT IO Term -> NamesT (TCMT IO) Term
forall (m :: * -> *) a. Monad m => m a -> NamesT m a
cl TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primIOne))
  Term
one <- TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primItIsOne
  Term
io  <- TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primIOne
  PrimitiveImpl -> TCM PrimitiveImpl
forall (m :: * -> *) a. Monad m => a -> m a
return (PrimitiveImpl -> TCM PrimitiveImpl)
-> PrimitiveImpl -> TCM PrimitiveImpl
forall a b. (a -> b) -> a -> b
$ Type -> PrimFun -> PrimitiveImpl
PrimImpl Type
t (PrimFun -> PrimitiveImpl) -> PrimFun -> PrimitiveImpl
forall a b. (a -> b) -> a -> b
$ QName
-> Arity
-> ([Arg Term] -> Arity -> ReduceM (Reduced MaybeReducedArgs Term))
-> PrimFun
PrimFun QName
forall a. HasCallStack => a
__IMPOSSIBLE__ Arity
5 (([Arg Term] -> Arity -> ReduceM (Reduced MaybeReducedArgs Term))
 -> PrimFun)
-> ([Arg Term] -> Arity -> ReduceM (Reduced MaybeReducedArgs Term))
-> PrimFun
forall a b. (a -> b) -> a -> b
$ \ [Arg Term]
ts Arity
nelims -> do
    case [Arg Term]
ts of
      [Arg Term
l,Arg Term
c,Arg Term
phi,Arg Term
u,Arg Term
a0] -> do
        Blocked (Arg Term)
sphi <- Arg Term -> ReduceM (Blocked (Arg Term))
forall t. Reduce t => t -> ReduceM (Blocked t)
reduceB' Arg Term
phi
        IntervalView
vphi <- Term -> ReduceM IntervalView
forall (m :: * -> *). HasBuiltins m => Term -> m IntervalView
intervalView (Term -> ReduceM IntervalView) -> Term -> ReduceM IntervalView
forall a b. (a -> b) -> a -> b
$ Arg Term -> Term
forall e. Arg e -> e
unArg (Arg Term -> Term) -> Arg Term -> Term
forall a b. (a -> b) -> a -> b
$ Blocked (Arg Term) -> Arg Term
forall t a. Blocked' t a -> a
ignoreBlocking Blocked (Arg Term)
sphi
        case IntervalView
vphi of
          IntervalView
IOne -> Term -> ReduceM (Reduced MaybeReducedArgs Term)
forall a a'. a -> ReduceM (Reduced a' a)
redReturn (Arg Term -> Term
forall e. Arg e -> e
unArg Arg Term
u Term -> [Arg Term] -> Term
forall t. Apply t => t -> [Arg Term] -> t
`apply` [Term -> Arg Term
forall e. e -> Arg e
argN Term
io, Term -> Arg Term
forall e. e -> Arg e
argN Term
one])
          IntervalView
_    -> do
            let getTermLocal :: String -> ReduceM Term
getTermLocal = String -> String -> ReduceM Term
forall (m :: * -> *). HasBuiltins m => String -> String -> m Term
getTerm (String -> String -> ReduceM Term)
-> String -> String -> ReduceM Term
forall a b. (a -> b) -> a -> b
$ String
builtinComp
            Term
tIMax <- String -> ReduceM Term
getTermLocal String
builtinIMax
            Term
tINeg <- String -> ReduceM Term
getTermLocal String
builtinINeg
            Term
tHComp <- String -> ReduceM Term
getTermLocal String
builtinHComp
            Term
tTrans <- String -> ReduceM Term
getTermLocal String
builtinTrans
            Term
iz      <- String -> ReduceM Term
getTermLocal String
builtinIZero
            Term -> ReduceM (Reduced MaybeReducedArgs Term)
forall a a'. a -> ReduceM (Reduced a' a)
redReturn (Term -> ReduceM (Reduced MaybeReducedArgs Term))
-> (NamesT ReduceM Term -> ReduceM Term)
-> NamesT ReduceM Term
-> ReduceM (Reduced MaybeReducedArgs Term)
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Names -> NamesT ReduceM Term -> ReduceM Term
forall (m :: * -> *) a. Names -> NamesT m a -> m a
runNamesT [] (NamesT ReduceM Term -> ReduceM (Reduced MaybeReducedArgs Term))
-> NamesT ReduceM Term -> ReduceM (Reduced MaybeReducedArgs Term)
forall a b. (a -> b) -> a -> b
$ do
              NamesT ReduceM Term
-> NamesT ReduceM Term
-> NamesT ReduceM Term
-> NamesT ReduceM Term
-> NamesT ReduceM Term
-> NamesT ReduceM Term
comp <- do
                let imax :: NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
imax NamesT ReduceM Term
i NamesT ReduceM Term
j = Term -> NamesT ReduceM Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
tIMax NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT ReduceM Term
i NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT ReduceM Term
j
                    forward :: NamesT ReduceM Term
-> NamesT ReduceM Term
-> NamesT ReduceM Term
-> NamesT ReduceM Term
-> NamesT ReduceM Term
forward NamesT ReduceM Term
la NamesT ReduceM Term
bA NamesT ReduceM Term
r NamesT ReduceM Term
u = Term -> NamesT ReduceM Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
tTrans NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> (String
-> (NamesT ReduceM Term -> NamesT ReduceM Term)
-> NamesT ReduceM Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
lam String
"i" ((NamesT ReduceM Term -> NamesT ReduceM Term)
 -> NamesT ReduceM Term)
-> (NamesT ReduceM Term -> NamesT ReduceM Term)
-> NamesT ReduceM Term
forall a b. (a -> b) -> a -> b
$ \ NamesT ReduceM Term
i -> NamesT ReduceM Term
la NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> (NamesT ReduceM Term
i NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
`imax` NamesT ReduceM Term
r))
                                                    NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> (String
-> (NamesT ReduceM Term -> NamesT ReduceM Term)
-> NamesT ReduceM Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
lam String
"i" ((NamesT ReduceM Term -> NamesT ReduceM Term)
 -> NamesT ReduceM Term)
-> (NamesT ReduceM Term -> NamesT ReduceM Term)
-> NamesT ReduceM Term
forall a b. (a -> b) -> a -> b
$ \ NamesT ReduceM Term
i -> NamesT ReduceM Term
bA NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> (NamesT ReduceM Term
i NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
`imax` NamesT ReduceM Term
r))
                                                    NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT ReduceM Term
r
                                                    NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT ReduceM Term
u
                (NamesT ReduceM Term
 -> NamesT ReduceM Term
 -> NamesT ReduceM Term
 -> NamesT ReduceM Term
 -> NamesT ReduceM Term
 -> NamesT ReduceM Term)
-> NamesT
     ReduceM
     (NamesT ReduceM Term
      -> NamesT ReduceM Term
      -> NamesT ReduceM Term
      -> NamesT ReduceM Term
      -> NamesT ReduceM Term
      -> NamesT ReduceM Term)
forall (m :: * -> *) a. Monad m => a -> m a
return ((NamesT ReduceM Term
  -> NamesT ReduceM Term
  -> NamesT ReduceM Term
  -> NamesT ReduceM Term
  -> NamesT ReduceM Term
  -> NamesT ReduceM Term)
 -> NamesT
      ReduceM
      (NamesT ReduceM Term
       -> NamesT ReduceM Term
       -> NamesT ReduceM Term
       -> NamesT ReduceM Term
       -> NamesT ReduceM Term
       -> NamesT ReduceM Term))
-> (NamesT ReduceM Term
    -> NamesT ReduceM Term
    -> NamesT ReduceM Term
    -> NamesT ReduceM Term
    -> NamesT ReduceM Term
    -> NamesT ReduceM Term)
-> NamesT
     ReduceM
     (NamesT ReduceM Term
      -> NamesT ReduceM Term
      -> NamesT ReduceM Term
      -> NamesT ReduceM Term
      -> NamesT ReduceM Term
      -> NamesT ReduceM Term)
forall a b. (a -> b) -> a -> b
$ \ NamesT ReduceM Term
la NamesT ReduceM Term
bA NamesT ReduceM Term
phi NamesT ReduceM Term
u NamesT ReduceM Term
u0 ->
                  Term -> NamesT ReduceM Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
tHComp NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> (NamesT ReduceM Term
la NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> Term -> NamesT ReduceM Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
io) NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> (NamesT ReduceM Term
bA NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> Term -> NamesT ReduceM Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
io) NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> NamesT ReduceM Term
phi
                              NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> String
-> (NamesT ReduceM Term -> NamesT ReduceM Term)
-> NamesT ReduceM Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
lam String
"i" (\ NamesT ReduceM Term
i -> String
-> (NamesT ReduceM Term -> NamesT ReduceM Term)
-> NamesT ReduceM Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
ilam String
"o" ((NamesT ReduceM Term -> NamesT ReduceM Term)
 -> NamesT ReduceM Term)
-> (NamesT ReduceM Term -> NamesT ReduceM Term)
-> NamesT ReduceM Term
forall a b. (a -> b) -> a -> b
$ \ NamesT ReduceM Term
o ->
                                      NamesT ReduceM Term
-> NamesT ReduceM Term
-> NamesT ReduceM Term
-> NamesT ReduceM Term
-> NamesT ReduceM Term
forward NamesT ReduceM Term
la NamesT ReduceM Term
bA NamesT ReduceM Term
i (NamesT ReduceM Term
u NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT ReduceM Term
i NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<..> NamesT ReduceM Term
o))
                              NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT ReduceM Term
-> NamesT ReduceM Term
-> NamesT ReduceM Term
-> NamesT ReduceM Term
-> NamesT ReduceM Term
forward NamesT ReduceM Term
la NamesT ReduceM Term
bA (Term -> NamesT ReduceM Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
iz) NamesT ReduceM Term
u0

              [NamesT ReduceM Term
l,NamesT ReduceM Term
c,NamesT ReduceM Term
phi,NamesT ReduceM Term
u,NamesT ReduceM Term
a0] <- (Arg Term -> NamesT ReduceM (NamesT ReduceM Term))
-> [Arg Term] -> NamesT ReduceM [NamesT ReduceM Term]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Term -> NamesT ReduceM (NamesT ReduceM Term)
forall (m :: * -> *) a.
(MonadFail m, Subst a) =>
a -> NamesT m (NamesT m a)
open (Term -> NamesT ReduceM (NamesT ReduceM Term))
-> (Arg Term -> Term)
-> Arg Term
-> NamesT ReduceM (NamesT ReduceM Term)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Arg Term -> Term
forall e. Arg e -> e
unArg) [Arg Term
l,Arg Term
c,Arg Term
phi,Arg Term
u,Arg Term
a0]
              NamesT ReduceM Term
-> NamesT ReduceM Term
-> NamesT ReduceM Term
-> NamesT ReduceM Term
-> NamesT ReduceM Term
-> NamesT ReduceM Term
comp NamesT ReduceM Term
l NamesT ReduceM Term
c NamesT ReduceM Term
phi NamesT ReduceM Term
u NamesT ReduceM Term
a0

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


prim_glueU' :: TCM PrimitiveImpl
prim_glueU' :: TCM PrimitiveImpl
prim_glueU' = do
  Cubical -> String -> TCM ()
requireCubical Cubical
CErased String
""
  Type
t <- Names -> NamesT (TCMT IO) Type -> TCMT IO Type
forall (m :: * -> *) a. Names -> NamesT m a -> m a
runNamesT [] (NamesT (TCMT IO) Type -> TCMT IO Type)
-> NamesT (TCMT IO) Type -> TCMT IO Type
forall a b. (a -> b) -> a -> b
$
       String
-> NamesT (TCMT IO) Type
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall (m :: * -> *).
(MonadFail m, MonadAddContext m, MonadDebug m) =>
String
-> NamesT m Type
-> (NamesT m Term -> NamesT m Type)
-> NamesT m Type
hPi' String
"la" (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
forall (m :: * -> *). Functor m => m Term -> m Type
el (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
forall a b. (a -> b) -> a -> b
$ TCMT IO Term -> NamesT (TCMT IO) Term
forall (m :: * -> *) a. Monad m => m a -> NamesT m a
cl TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primLevel) (\ NamesT (TCMT IO) Term
la ->
       String
-> NamesT (TCMT IO) Type
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall (m :: * -> *).
(MonadFail m, MonadAddContext m, MonadDebug m) =>
String
-> NamesT m Type
-> (NamesT m Term -> NamesT m Type)
-> NamesT m Type
hPi' String
"φ" NamesT (TCMT IO) Type
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Type
primIntervalType ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
 -> NamesT (TCMT IO) Type)
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall a b. (a -> b) -> a -> b
$ \ NamesT (TCMT IO) Term
φ ->
       String
-> NamesT (TCMT IO) Type
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall (m :: * -> *).
(MonadFail m, MonadAddContext m, MonadDebug m) =>
String
-> NamesT m Type
-> (NamesT m Term -> NamesT m Type)
-> NamesT m Type
hPi' String
"T" (String
-> NamesT (TCMT IO) Type
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall (m :: * -> *).
(MonadFail m, MonadAddContext m, MonadDebug m) =>
String
-> NamesT m Type
-> (NamesT m Term -> NamesT m Type)
-> NamesT m Type
nPi' String
"i" NamesT (TCMT IO) Type
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Type
primIntervalType ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
 -> NamesT (TCMT IO) Type)
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall a b. (a -> b) -> a -> b
$ \ NamesT (TCMT IO) Term
_ -> String
-> NamesT (TCMT IO) Term
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall (m :: * -> *).
(MonadAddContext m, HasBuiltins m, MonadDebug m) =>
String
-> NamesT m Term
-> (NamesT m Term -> NamesT m Type)
-> NamesT m Type
pPi' String
"o" NamesT (TCMT IO) Term
φ ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
 -> NamesT (TCMT IO) Type)
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall a b. (a -> b) -> a -> b
$ \ NamesT (TCMT IO) Term
o -> Sort' Term -> Type
sort (Sort' Term -> Type) -> (Term -> Sort' Term) -> Term -> Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term -> Sort' Term
tmSort (Term -> Type) -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamesT (TCMT IO) Term
la) ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
 -> NamesT (TCMT IO) Type)
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall a b. (a -> b) -> a -> b
$ \ NamesT (TCMT IO) Term
t ->
       String
-> NamesT (TCMT IO) Type
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall (m :: * -> *).
(MonadFail m, MonadAddContext m, MonadDebug m) =>
String
-> NamesT m Type
-> (NamesT m Term -> NamesT m Type)
-> NamesT m Type
hPi' String
"A" (NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Type
el's (TCMT IO Term -> NamesT (TCMT IO) Term
forall (m :: * -> *) a. Monad m => m a -> NamesT m a
cl TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primLevelSuc NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT (TCMT IO) Term
la) (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
forall a b. (a -> b) -> a -> b
$ TCMT IO Term -> NamesT (TCMT IO) Term
forall (m :: * -> *) a. Monad m => m a -> NamesT m a
cl TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primSub 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
primLevelSuc NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT (TCMT IO) Term
la) NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> (Sort' Term -> Term
Sort (Sort' Term -> Term) -> (Term -> Sort' Term) -> Term -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term -> Sort' Term
tmSort (Term -> Term) -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamesT (TCMT IO) Term
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
φ 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
t NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT (TCMT IO) Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primIZero)) ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
 -> NamesT (TCMT IO) Type)
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall a b. (a -> b) -> a -> b
$ \ NamesT (TCMT IO) Term
a -> do
       let bA :: NamesT (TCMT IO) Term
bA = (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
primSubOut 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
primLevelSuc NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT (TCMT IO) Term
la) NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> (Sort' Term -> Term
Sort (Sort' Term -> Term) -> (Term -> Sort' Term) -> Term -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term -> Sort' Term
tmSort (Term -> Term) -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamesT (TCMT IO) Term
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
φ 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
t NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT (TCMT IO) Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primIZero) NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT (TCMT IO) Term
a)
       String
-> NamesT (TCMT IO) Term
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall (m :: * -> *).
(MonadAddContext m, HasBuiltins m, MonadDebug m) =>
String
-> NamesT m Term
-> (NamesT m Term -> NamesT m Type)
-> NamesT m Type
pPi' String
"o" NamesT (TCMT IO) Term
φ (\ NamesT (TCMT IO) Term
o -> NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Type
el' NamesT (TCMT IO) Term
la (NamesT (TCMT IO) Term
t NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> TCMT IO Term -> NamesT (TCMT IO) Term
forall (m :: * -> *) a. Monad m => m a -> NamesT m a
cl TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primIOne NamesT (TCMT IO) Term
-> 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) Type
-> NamesT (TCMT IO) Type -> NamesT (TCMT IO) Type
forall (m :: * -> *). Applicative m => m Type -> m Type -> m Type
--> (NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Type
el' NamesT (TCMT IO) Term
la NamesT (TCMT IO) Term
bA)
         NamesT (TCMT IO) Type
-> NamesT (TCMT IO) Type -> NamesT (TCMT IO) Type
forall (m :: * -> *). Applicative m => m Type -> m Type -> m Type
--> NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Type
el' NamesT (TCMT IO) Term
la (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
primHComp 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
primLevelSuc NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT (TCMT IO) Term
la) NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> (Sort' Term -> Term
Sort (Sort' Term -> Term) -> (Term -> Sort' Term) -> Term -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term -> Sort' Term
tmSort (Term -> Term) -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamesT (TCMT IO) Term
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
φ 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
t 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))
  Term -> IntervalView
view <- TCMT IO (Term -> IntervalView)
forall (m :: * -> *). HasBuiltins m => m (Term -> IntervalView)
intervalView'
  Term
one <- TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primItIsOne
  PrimitiveImpl -> TCM PrimitiveImpl
forall (m :: * -> *) a. Monad m => a -> m a
return (PrimitiveImpl -> TCM PrimitiveImpl)
-> PrimitiveImpl -> TCM PrimitiveImpl
forall a b. (a -> b) -> a -> b
$ Type -> PrimFun -> PrimitiveImpl
PrimImpl Type
t (PrimFun -> PrimitiveImpl) -> PrimFun -> PrimitiveImpl
forall a b. (a -> b) -> a -> b
$ QName
-> Arity
-> ([Arg Term] -> ReduceM (Reduced MaybeReducedArgs Term))
-> PrimFun
primFun QName
forall a. HasCallStack => a
__IMPOSSIBLE__ Arity
6 (([Arg Term] -> ReduceM (Reduced MaybeReducedArgs Term))
 -> PrimFun)
-> ([Arg Term] -> ReduceM (Reduced MaybeReducedArgs Term))
-> PrimFun
forall a b. (a -> b) -> a -> b
$ \[Arg Term]
ts ->
    case [Arg Term]
ts of
      [Arg Term
la,Arg Term
phi,Arg Term
bT,Arg Term
bA,Arg Term
t,Arg Term
a] -> do
       Blocked (Arg Term)
sphi <- Arg Term -> ReduceM (Blocked (Arg Term))
forall t. Reduce t => t -> ReduceM (Blocked t)
reduceB' Arg Term
phi
       case Term -> IntervalView
view (Term -> IntervalView) -> Term -> IntervalView
forall a b. (a -> b) -> a -> b
$ Arg Term -> Term
forall e. Arg e -> e
unArg (Arg Term -> Term) -> Arg Term -> Term
forall a b. (a -> b) -> a -> b
$ Blocked (Arg Term) -> Arg Term
forall t a. Blocked' t a -> a
ignoreBlocking (Blocked (Arg Term) -> Arg Term) -> Blocked (Arg Term) -> Arg Term
forall a b. (a -> b) -> a -> b
$ Blocked (Arg Term)
sphi of
         IntervalView
IOne -> Term -> ReduceM (Reduced MaybeReducedArgs Term)
forall a a'. a -> ReduceM (Reduced a' a)
redReturn (Term -> ReduceM (Reduced MaybeReducedArgs Term))
-> Term -> ReduceM (Reduced MaybeReducedArgs Term)
forall a b. (a -> b) -> a -> b
$ Arg Term -> Term
forall e. Arg e -> e
unArg Arg Term
t Term -> [Arg Term] -> Term
forall t. Apply t => t -> [Arg Term] -> t
`apply` [Term -> Arg Term
forall e. e -> Arg e
argN Term
one]
         IntervalView
_    -> Reduced MaybeReducedArgs Term
-> ReduceM (Reduced MaybeReducedArgs Term)
forall (m :: * -> *) a. Monad m => a -> m a
return (MaybeReducedArgs -> Reduced MaybeReducedArgs Term
forall no yes. no -> Reduced no yes
NoReduction (MaybeReducedArgs -> Reduced MaybeReducedArgs Term)
-> MaybeReducedArgs -> Reduced MaybeReducedArgs Term
forall a b. (a -> b) -> a -> b
$ (Arg Term -> MaybeReduced (Arg Term))
-> [Arg Term] -> MaybeReducedArgs
forall a b. (a -> b) -> [a] -> [b]
map Arg Term -> MaybeReduced (Arg Term)
forall a. a -> MaybeReduced a
notReduced [Arg Term
la] MaybeReducedArgs -> MaybeReducedArgs -> MaybeReducedArgs
forall a. [a] -> [a] -> [a]
++ [Blocked (Arg Term) -> MaybeReduced (Arg Term)
reduced Blocked (Arg Term)
sphi] MaybeReducedArgs -> MaybeReducedArgs -> MaybeReducedArgs
forall a. [a] -> [a] -> [a]
++ (Arg Term -> MaybeReduced (Arg Term))
-> [Arg Term] -> MaybeReducedArgs
forall a b. (a -> b) -> [a] -> [b]
map Arg Term -> MaybeReduced (Arg Term)
forall a. a -> MaybeReduced a
notReduced [Arg Term
bT,Arg Term
bA,Arg Term
t,Arg Term
a])
      [Arg Term]
_ -> ReduceM (Reduced MaybeReducedArgs Term)
forall a. HasCallStack => a
__IMPOSSIBLE__

prim_unglueU' :: TCM PrimitiveImpl
prim_unglueU' :: TCM PrimitiveImpl
prim_unglueU' = do
  Cubical -> String -> TCM ()
requireCubical Cubical
CErased String
""
  Type
t <- Names -> NamesT (TCMT IO) Type -> TCMT IO Type
forall (m :: * -> *) a. Names -> NamesT m a -> m a
runNamesT [] (NamesT (TCMT IO) Type -> TCMT IO Type)
-> NamesT (TCMT IO) Type -> TCMT IO Type
forall a b. (a -> b) -> a -> b
$
       String
-> NamesT (TCMT IO) Type
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall (m :: * -> *).
(MonadFail m, MonadAddContext m, MonadDebug m) =>
String
-> NamesT m Type
-> (NamesT m Term -> NamesT m Type)
-> NamesT m Type
hPi' String
"la" (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
forall (m :: * -> *). Functor m => m Term -> m Type
el (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
forall a b. (a -> b) -> a -> b
$ TCMT IO Term -> NamesT (TCMT IO) Term
forall (m :: * -> *) a. Monad m => m a -> NamesT m a
cl TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primLevel) (\ NamesT (TCMT IO) Term
la ->
       String
-> NamesT (TCMT IO) Type
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall (m :: * -> *).
(MonadFail m, MonadAddContext m, MonadDebug m) =>
String
-> NamesT m Type
-> (NamesT m Term -> NamesT m Type)
-> NamesT m Type
hPi' String
"φ" NamesT (TCMT IO) Type
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Type
primIntervalType ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
 -> NamesT (TCMT IO) Type)
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall a b. (a -> b) -> a -> b
$ \ NamesT (TCMT IO) Term
φ ->
       String
-> NamesT (TCMT IO) Type
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall (m :: * -> *).
(MonadFail m, MonadAddContext m, MonadDebug m) =>
String
-> NamesT m Type
-> (NamesT m Term -> NamesT m Type)
-> NamesT m Type
hPi' String
"T" (String
-> NamesT (TCMT IO) Type
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall (m :: * -> *).
(MonadFail m, MonadAddContext m, MonadDebug m) =>
String
-> NamesT m Type
-> (NamesT m Term -> NamesT m Type)
-> NamesT m Type
nPi' String
"i" NamesT (TCMT IO) Type
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Type
primIntervalType ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
 -> NamesT (TCMT IO) Type)
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall a b. (a -> b) -> a -> b
$ \ NamesT (TCMT IO) Term
_ -> String
-> NamesT (TCMT IO) Term
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall (m :: * -> *).
(MonadAddContext m, HasBuiltins m, MonadDebug m) =>
String
-> NamesT m Term
-> (NamesT m Term -> NamesT m Type)
-> NamesT m Type
pPi' String
"o" NamesT (TCMT IO) Term
φ ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
 -> NamesT (TCMT IO) Type)
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall a b. (a -> b) -> a -> b
$ \ NamesT (TCMT IO) Term
o -> Sort' Term -> Type
sort (Sort' Term -> Type) -> (Term -> Sort' Term) -> Term -> Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term -> Sort' Term
tmSort (Term -> Type) -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamesT (TCMT IO) Term
la) ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
 -> NamesT (TCMT IO) Type)
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall a b. (a -> b) -> a -> b
$ \ NamesT (TCMT IO) Term
t ->
       String
-> NamesT (TCMT IO) Type
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall (m :: * -> *).
(MonadFail m, MonadAddContext m, MonadDebug m) =>
String
-> NamesT m Type
-> (NamesT m Term -> NamesT m Type)
-> NamesT m Type
hPi' String
"A" (NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Type
el's (TCMT IO Term -> NamesT (TCMT IO) Term
forall (m :: * -> *) a. Monad m => m a -> NamesT m a
cl TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primLevelSuc NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT (TCMT IO) Term
la) (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
forall a b. (a -> b) -> a -> b
$ TCMT IO Term -> NamesT (TCMT IO) Term
forall (m :: * -> *) a. Monad m => m a -> NamesT m a
cl TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primSub 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
primLevelSuc NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT (TCMT IO) Term
la) NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> (Sort' Term -> Term
Sort (Sort' Term -> Term) -> (Term -> Sort' Term) -> Term -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term -> Sort' Term
tmSort (Term -> Term) -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamesT (TCMT IO) Term
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
φ 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
t NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT (TCMT IO) Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primIZero)) ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
 -> NamesT (TCMT IO) Type)
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall a b. (a -> b) -> a -> b
$ \ NamesT (TCMT IO) Term
a -> do
       let bA :: NamesT (TCMT IO) Term
bA = (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
primSubOut 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
primLevelSuc NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT (TCMT IO) Term
la) NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> (Sort' Term -> Term
Sort (Sort' Term -> Term) -> (Term -> Sort' Term) -> Term -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term -> Sort' Term
tmSort (Term -> Term) -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamesT (TCMT IO) Term
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
φ 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
t NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT (TCMT IO) Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primIZero) NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT (TCMT IO) Term
a)
       NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Type
el' NamesT (TCMT IO) Term
la (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
primHComp 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
primLevelSuc NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT (TCMT IO) Term
la) NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> (Sort' Term -> Term
Sort (Sort' Term -> Term) -> (Term -> Sort' Term) -> Term -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term -> Sort' Term
tmSort (Term -> Term) -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamesT (TCMT IO) Term
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
φ 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
t 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) Type
-> NamesT (TCMT IO) Type -> NamesT (TCMT IO) Type
forall (m :: * -> *). Applicative m => m Type -> m Type -> m Type
--> NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Type
el' NamesT (TCMT IO) Term
la NamesT (TCMT IO) Term
bA)
  Term -> IntervalView
view <- TCMT IO (Term -> IntervalView)
forall (m :: * -> *). HasBuiltins m => m (Term -> IntervalView)
intervalView'
  Term
one <- TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primItIsOne
  Maybe QName
mglueU <- String -> TCMT IO (Maybe QName)
forall (m :: * -> *). HasBuiltins m => String -> m (Maybe QName)
getPrimitiveName' String
builtin_glueU
  Maybe QName
mtransp <- String -> TCMT IO (Maybe QName)
forall (m :: * -> *). HasBuiltins m => String -> m (Maybe QName)
getPrimitiveName' String
builtinTrans
  Maybe QName
mHCompU <- String -> TCMT IO (Maybe QName)
forall (m :: * -> *). HasBuiltins m => String -> m (Maybe QName)
getPrimitiveName' String
builtinHComp
  let mhcomp :: Maybe QName
mhcomp = Maybe QName
mHCompU
  PrimitiveImpl -> TCM PrimitiveImpl
forall (m :: * -> *) a. Monad m => a -> m a
return (PrimitiveImpl -> TCM PrimitiveImpl)
-> PrimitiveImpl -> TCM PrimitiveImpl
forall a b. (a -> b) -> a -> b
$ Type -> PrimFun -> PrimitiveImpl
PrimImpl Type
t (PrimFun -> PrimitiveImpl) -> PrimFun -> PrimitiveImpl
forall a b. (a -> b) -> a -> b
$ QName
-> Arity
-> ([Arg Term] -> ReduceM (Reduced MaybeReducedArgs Term))
-> PrimFun
primFun QName
forall a. HasCallStack => a
__IMPOSSIBLE__ Arity
5 (([Arg Term] -> ReduceM (Reduced MaybeReducedArgs Term))
 -> PrimFun)
-> ([Arg Term] -> ReduceM (Reduced MaybeReducedArgs Term))
-> PrimFun
forall a b. (a -> b) -> a -> b
$ \[Arg Term]
ts ->
    case [Arg Term]
ts of
      [Arg Term
la,Arg Term
phi,Arg Term
bT,Arg Term
bA,Arg Term
b] -> do
       Blocked (Arg Term)
sphi <- Arg Term -> ReduceM (Blocked (Arg Term))
forall t. Reduce t => t -> ReduceM (Blocked t)
reduceB' Arg Term
phi
       case Term -> IntervalView
view (Term -> IntervalView) -> Term -> IntervalView
forall a b. (a -> b) -> a -> b
$ Arg Term -> Term
forall e. Arg e -> e
unArg (Arg Term -> Term) -> Arg Term -> Term
forall a b. (a -> b) -> a -> b
$ Blocked (Arg Term) -> Arg Term
forall t a. Blocked' t a -> a
ignoreBlocking (Blocked (Arg Term) -> Arg Term) -> Blocked (Arg Term) -> Arg Term
forall a b. (a -> b) -> a -> b
$ Blocked (Arg Term)
sphi of
         IntervalView
IOne -> do
           Term
tTransp <- String -> String -> ReduceM Term
forall (m :: * -> *). HasBuiltins m => String -> String -> m Term
getTerm String
builtin_unglueU String
builtinTrans
           Term
iNeg    <- String -> String -> ReduceM Term
forall (m :: * -> *). HasBuiltins m => String -> String -> m Term
getTerm String
builtin_unglueU String
builtinINeg
           Term
iZ      <- String -> String -> ReduceM Term
forall (m :: * -> *). HasBuiltins m => String -> String -> m Term
getTerm String
builtin_unglueU String
builtinIZero
           Term -> ReduceM (Reduced MaybeReducedArgs Term)
forall a a'. a -> ReduceM (Reduced a' a)
redReturn (Term -> ReduceM (Reduced MaybeReducedArgs Term))
-> (NamesT ReduceM Term -> ReduceM Term)
-> NamesT ReduceM Term
-> ReduceM (Reduced MaybeReducedArgs Term)
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Names -> NamesT ReduceM Term -> ReduceM Term
forall (m :: * -> *) a. Names -> NamesT m a -> m a
runNamesT [] (NamesT ReduceM Term -> ReduceM (Reduced MaybeReducedArgs Term))
-> NamesT ReduceM Term -> ReduceM (Reduced MaybeReducedArgs Term)
forall a b. (a -> b) -> a -> b
$ do
             [NamesT ReduceM Term
la,NamesT ReduceM Term
bT,NamesT ReduceM Term
b] <- (Arg Term -> NamesT ReduceM (NamesT ReduceM Term))
-> [Arg Term] -> NamesT ReduceM [NamesT ReduceM Term]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Term -> NamesT ReduceM (NamesT ReduceM Term)
forall (m :: * -> *) a.
(MonadFail m, Subst a) =>
a -> NamesT m (NamesT m a)
open (Term -> NamesT ReduceM (NamesT ReduceM Term))
-> (Arg Term -> Term)
-> Arg Term
-> NamesT ReduceM (NamesT ReduceM Term)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Arg Term -> Term
forall e. Arg e -> e
unArg) [Arg Term
la,Arg Term
bT,Arg Term
b]
             Term -> NamesT ReduceM Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
tTransp NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> String
-> (NamesT ReduceM Term -> NamesT ReduceM Term)
-> NamesT ReduceM Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
lam String
"i" (\ NamesT ReduceM Term
_ -> NamesT ReduceM Term
la)
                          NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> String
-> (NamesT ReduceM Term -> NamesT ReduceM Term)
-> NamesT ReduceM Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
lam String
"i" (\ NamesT ReduceM Term
i -> NamesT ReduceM Term
bT NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> (Term -> NamesT ReduceM Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
iNeg NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT ReduceM Term
i) NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<..> Term -> NamesT ReduceM Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
one)
                          NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> Term -> NamesT ReduceM Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
iZ
                          NamesT ReduceM Term -> NamesT ReduceM Term -> NamesT ReduceM Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT ReduceM Term
b
         IntervalView
_    -> do
            Blocked (Arg Term)
sb <- Arg Term -> ReduceM (Blocked (Arg Term))
forall t. Reduce t => t -> ReduceM (Blocked t)
reduceB' Arg Term
b
            let fallback :: Blocked (Arg Term) -> ReduceM (Reduced MaybeReducedArgs Term)
fallback Blocked (Arg Term)
sbA = Reduced MaybeReducedArgs Term
-> ReduceM (Reduced MaybeReducedArgs Term)
forall (m :: * -> *) a. Monad m => a -> m a
return (MaybeReducedArgs -> Reduced MaybeReducedArgs Term
forall no yes. no -> Reduced no yes
NoReduction (MaybeReducedArgs -> Reduced MaybeReducedArgs Term)
-> MaybeReducedArgs -> Reduced MaybeReducedArgs Term
forall a b. (a -> b) -> a -> b
$ (Arg Term -> MaybeReduced (Arg Term))
-> [Arg Term] -> MaybeReducedArgs
forall a b. (a -> b) -> [a] -> [b]
map Arg Term -> MaybeReduced (Arg Term)
forall a. a -> MaybeReduced a
notReduced [Arg Term
la] MaybeReducedArgs -> MaybeReducedArgs -> MaybeReducedArgs
forall a. [a] -> [a] -> [a]
++ [Blocked (Arg Term) -> MaybeReduced (Arg Term)
reduced Blocked (Arg Term)
sphi] MaybeReducedArgs -> MaybeReducedArgs -> MaybeReducedArgs
forall a. [a] -> [a] -> [a]
++ (Arg Term -> MaybeReduced (Arg Term))
-> [Arg Term] -> MaybeReducedArgs
forall a b. (a -> b) -> [a] -> [b]
map Arg Term -> MaybeReduced (Arg Term)
forall a. a -> MaybeReduced a
notReduced [Arg Term
bT,Arg Term
bA] MaybeReducedArgs -> MaybeReducedArgs -> MaybeReducedArgs
forall a. [a] -> [a] -> [a]
++ [Blocked (Arg Term) -> MaybeReduced (Arg Term)
reduced Blocked (Arg Term)
sb])
            case Arg Term -> Term
forall e. Arg e -> e
unArg (Arg Term -> Term) -> Arg Term -> Term
forall a b. (a -> b) -> a -> b
$ Blocked (Arg Term) -> Arg Term
forall t a. Blocked' t a -> a
ignoreBlocking (Blocked (Arg Term) -> Arg Term) -> Blocked (Arg Term) -> Arg Term
forall a b. (a -> b) -> a -> b
$ Blocked (Arg Term)
sb of
               Def QName
q [Apply Arg Term
_,Apply Arg Term
_,Apply Arg Term
_,Apply Arg Term
_,Apply Arg Term
_,Apply Arg Term
a]
                     | QName -> Maybe QName
forall a. a -> Maybe a
Just QName
q Maybe QName -> Maybe QName -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe QName
mglueU -> Term -> ReduceM (Reduced MaybeReducedArgs Term)
forall a a'. a -> ReduceM (Reduced a' a)
redReturn (Term -> ReduceM (Reduced MaybeReducedArgs Term))
-> Term -> ReduceM (Reduced MaybeReducedArgs Term)
forall a b. (a -> b) -> a -> b
$ Arg Term -> Term
forall e. Arg e -> e
unArg Arg Term
a
               Def QName
q [Apply Arg Term
l,Apply Arg Term
bA,Apply Arg Term
r,Apply Arg Term
u0]
                     | QName -> Maybe QName
forall a. a -> Maybe a
Just QName
q Maybe QName -> Maybe QName -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe QName
mtransp -> do
                     Blocked (Arg Term)
sbA <- Arg Term -> ReduceM (Blocked (Arg Term))
forall a (m :: * -> *).
(Reduce a, MonadReduce m) =>
a -> m (Blocked a)
reduceB Arg Term
bA
                     case Arg Term -> Term
forall e. Arg e -> e
unArg (Arg Term -> Term) -> Arg Term -> Term
forall a b. (a -> b) -> a -> b
$ Blocked (Arg Term) -> Arg Term
forall t a. Blocked' t a -> a
ignoreBlocking Blocked (Arg Term)
sbA of
                       Lam ArgInfo
_ Abs Term
t -> do
                         Blocked' Term Term
st <- Term -> ReduceM (Blocked' Term Term)
forall t. Reduce t => t -> ReduceM (Blocked t)
reduceB' (Abs Term -> Term
forall a. Subst a => Abs a -> a
absBody Abs Term
t)
                         case Blocked' Term Term -> Term
forall t a. Blocked' t a -> a
ignoreBlocking Blocked' Term Term
st of
                           Def QName
h [Elim]
es | Just [Arg Term
la,Arg Term
_,Arg Term
phi,Arg Term
bT,Arg Term
bA] <- [Elim] -> Maybe [Arg Term]
forall a. [Elim' a] -> Maybe [Arg a]
allApplyElims [Elim]
es, QName -> Maybe QName
forall a. a -> Maybe a
Just QName
h Maybe QName -> Maybe QName -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe QName
mHCompU -> do
                             Term -> ReduceM (Reduced MaybeReducedArgs Term)
forall a a'. a -> ReduceM (Reduced a' a)
redReturn (Term -> ReduceM (Reduced MaybeReducedArgs Term))
-> (Maybe Term -> Term)
-> Maybe Term
-> ReduceM (Reduced MaybeReducedArgs Term)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term -> Maybe Term -> Term
forall a. a -> Maybe a -> a
fromMaybe Term
forall a. HasCallStack => a
__IMPOSSIBLE__ (Maybe Term -> ReduceM (Reduced MaybeReducedArgs Term))
-> ReduceM (Maybe Term) -> ReduceM (Reduced MaybeReducedArgs Term)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< TranspOrHComp
-> Arg Term
-> Maybe (Arg Term)
-> Arg Term
-> FamilyOrNot (Arg Term, Arg Term, Arg Term, Arg Term)
-> TermPosition
-> ReduceM (Maybe Term)
forall (m :: * -> *).
PureTCM m =>
TranspOrHComp
-> Arg Term
-> Maybe (Arg Term)
-> Arg Term
-> FamilyOrNot (Arg Term, Arg Term, Arg Term, Arg Term)
-> TermPosition
-> m (Maybe Term)
compHCompU TranspOrHComp
DoTransp Arg Term
r Maybe (Arg Term)
forall a. Maybe a
Nothing Arg Term
u0 ((Arg Term, Arg Term, Arg Term, Arg Term)
-> FamilyOrNot (Arg Term, Arg Term, Arg Term, Arg Term)
forall a. a -> FamilyOrNot a
IsFam (Arg Term
la,Arg Term
phi,Arg Term
bT,Arg Term
bA)) TermPosition
Eliminated
                           Term
_ -> Blocked (Arg Term) -> ReduceM (Reduced MaybeReducedArgs Term)
fallback (Blocked' Term Term
st Blocked' Term Term -> Blocked (Arg Term) -> Blocked (Arg Term)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Blocked (Arg Term)
sbA)
                       Term
_  -> Blocked (Arg Term) -> ReduceM (Reduced MaybeReducedArgs Term)
fallback Blocked (Arg Term)
sbA
               Def QName
q [Apply Arg Term
l,Apply Arg Term
bA,Apply Arg Term
r,Apply Arg Term
u,Apply Arg Term
u0]
                     | QName -> Maybe QName
forall a. a -> Maybe a
Just QName
q Maybe QName -> Maybe QName -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe QName
mhcomp -> do
                     Blocked (Arg Term)
sbA <- Arg Term -> ReduceM (Blocked (Arg Term))
forall a (m :: * -> *).
(Reduce a, MonadReduce m) =>
a -> m (Blocked a)
reduceB Arg Term
bA
                     case Arg Term -> Term
forall e. Arg e -> e
unArg (Arg Term -> Term) -> Arg Term -> Term
forall a b. (a -> b) -> a -> b
$ Blocked (Arg Term) -> Arg Term
forall t a. Blocked' t a -> a
ignoreBlocking Blocked (Arg Term)
sbA of
                       Def QName
h [Elim]
es | Just [Arg Term
la,Arg Term
_,Arg Term
phi,Arg Term
bT,Arg Term
bA] <- [Elim] -> Maybe [Arg Term]
forall a. [Elim' a] -> Maybe [Arg a]
allApplyElims [Elim]
es, QName -> Maybe QName
forall a. a -> Maybe a
Just QName
h Maybe QName -> Maybe QName -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe QName
mHCompU -> do
                         Term -> ReduceM (Reduced MaybeReducedArgs Term)
forall a a'. a -> ReduceM (Reduced a' a)
redReturn (Term -> ReduceM (Reduced MaybeReducedArgs Term))
-> (Maybe Term -> Term)
-> Maybe Term
-> ReduceM (Reduced MaybeReducedArgs Term)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term -> Maybe Term -> Term
forall a. a -> Maybe a -> a
fromMaybe Term
forall a. HasCallStack => a
__IMPOSSIBLE__ (Maybe Term -> ReduceM (Reduced MaybeReducedArgs Term))
-> ReduceM (Maybe Term) -> ReduceM (Reduced MaybeReducedArgs Term)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< TranspOrHComp
-> Arg Term
-> Maybe (Arg Term)
-> Arg Term
-> FamilyOrNot (Arg Term, Arg Term, Arg Term, Arg Term)
-> TermPosition
-> ReduceM (Maybe Term)
forall (m :: * -> *).
PureTCM m =>
TranspOrHComp
-> Arg Term
-> Maybe (Arg Term)
-> Arg Term
-> FamilyOrNot (Arg Term, Arg Term, Arg Term, Arg Term)
-> TermPosition
-> m (Maybe Term)
compHCompU TranspOrHComp
DoHComp Arg Term
r (Arg Term -> Maybe (Arg Term)
forall a. a -> Maybe a
Just Arg Term
u) Arg Term
u0 ((Arg Term, Arg Term, Arg Term, Arg Term)
-> FamilyOrNot (Arg Term, Arg Term, Arg Term, Arg Term)
forall a. a -> FamilyOrNot a
IsNot (Arg Term
la,Arg Term
phi,Arg Term
bT,Arg Term
bA)) TermPosition
Eliminated
                       Term
_ -> Blocked (Arg Term) -> ReduceM (Reduced MaybeReducedArgs Term)
fallback Blocked (Arg Term)
sbA
               Term
_ -> Reduced MaybeReducedArgs Term
-> ReduceM (Reduced MaybeReducedArgs Term)
forall (m :: * -> *) a. Monad m => a -> m a
return (MaybeReducedArgs -> Reduced MaybeReducedArgs Term
forall no yes. no -> Reduced no yes
NoReduction (MaybeReducedArgs -> Reduced MaybeReducedArgs Term)
-> MaybeReducedArgs -> Reduced MaybeReducedArgs Term
forall a b. (a -> b) -> a -> b
$ (Arg Term -> MaybeReduced (Arg Term))
-> [Arg Term] -> MaybeReducedArgs
forall a b. (a -> b) -> [a] -> [b]
map Arg Term -> MaybeReduced (Arg Term)
forall a. a -> MaybeReduced a
notReduced [Arg Term
la] MaybeReducedArgs -> MaybeReducedArgs -> MaybeReducedArgs
forall a. [a] -> [a] -> [a]
++ [Blocked (Arg Term) -> MaybeReduced (Arg Term)
reduced Blocked (Arg Term)
sphi] MaybeReducedArgs -> MaybeReducedArgs -> MaybeReducedArgs
forall a. [a] -> [a] -> [a]
++ (Arg Term -> MaybeReduced (Arg Term))
-> [Arg Term] -> MaybeReducedArgs
forall a b. (a -> b) -> [a] -> [b]
map Arg Term -> MaybeReduced (Arg Term)
forall a. a -> MaybeReduced a
notReduced [Arg Term
bT,Arg Term
bA] MaybeReducedArgs -> MaybeReducedArgs -> MaybeReducedArgs
forall a. [a] -> [a] -> [a]
++ [Blocked (Arg Term) -> MaybeReduced (Arg Term)
reduced Blocked (Arg Term)
sb])
      [Arg Term]
_ -> ReduceM (Reduced MaybeReducedArgs Term)
forall a. HasCallStack => a
__IMPOSSIBLE__


primGlue' :: TCM PrimitiveImpl
primGlue' :: TCM PrimitiveImpl
primGlue' = do
  Cubical -> String -> TCM ()
requireCubical Cubical
CFull String
""
  -- Glue' : ∀ {l} (A : Set l) → ∀ φ → (T : Partial (Set a) φ) (f : (PartialP φ \ o → (T o) -> A))
  --            ([f] : PartialP φ \ o → isEquiv (T o) A (f o)) → Set l
  Type
t <- Names -> NamesT (TCMT IO) Type -> TCMT IO Type
forall (m :: * -> *) a. Names -> NamesT m a -> m a
runNamesT [] (NamesT (TCMT IO) Type -> TCMT IO Type)
-> NamesT (TCMT IO) Type -> TCMT IO Type
forall a b. (a -> b) -> a -> b
$
       String
-> NamesT (TCMT IO) Type
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall (m :: * -> *).
(MonadFail m, MonadAddContext m, MonadDebug m) =>
String
-> NamesT m Type
-> (NamesT m Term -> NamesT m Type)
-> NamesT m Type
hPi' String
"la" (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
forall (m :: * -> *). Functor m => m Term -> m Type
el (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
forall a b. (a -> b) -> a -> b
$ TCMT IO Term -> NamesT (TCMT IO) Term
forall (m :: * -> *) a. Monad m => m a -> NamesT m a
cl TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primLevel) (\ NamesT (TCMT IO) Term
la ->
       String
-> NamesT (TCMT IO) Type
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall (m :: * -> *).
(MonadFail m, MonadAddContext m, MonadDebug m) =>
String
-> NamesT m Type
-> (NamesT m Term -> NamesT m Type)
-> NamesT m Type
hPi' String
"lb" (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
forall (m :: * -> *). Functor m => m Term -> m Type
el (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
forall a b. (a -> b) -> a -> b
$ TCMT IO Term -> NamesT (TCMT IO) Term
forall (m :: * -> *) a. Monad m => m a -> NamesT m a
cl TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primLevel) ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
 -> NamesT (TCMT IO) Type)
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall a b. (a -> b) -> a -> b
$ \ NamesT (TCMT IO) Term
lb ->
       String
-> NamesT (TCMT IO) Type
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall (m :: * -> *).
(MonadFail m, MonadAddContext m, MonadDebug m) =>
String
-> NamesT m Type
-> (NamesT m Term -> NamesT m Type)
-> NamesT m Type
nPi' String
"A" (Sort' Term -> Type
sort (Sort' Term -> Type) -> (Term -> Sort' Term) -> Term -> Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term -> Sort' Term
tmSort (Term -> Type) -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamesT (TCMT IO) Term
la) ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
 -> NamesT (TCMT IO) Type)
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall a b. (a -> b) -> a -> b
$ \ NamesT (TCMT IO) Term
a ->
       String
-> NamesT (TCMT IO) Type
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall (m :: * -> *).
(MonadFail m, MonadAddContext m, MonadDebug m) =>
String
-> NamesT m Type
-> (NamesT m Term -> NamesT m Type)
-> NamesT m Type
hPi' String
"φ" NamesT (TCMT IO) Type
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Type
primIntervalType ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
 -> NamesT (TCMT IO) Type)
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall a b. (a -> b) -> a -> b
$ \ NamesT (TCMT IO) Term
φ ->
       String
-> NamesT (TCMT IO) Type
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall (m :: * -> *).
(MonadFail m, MonadAddContext m, MonadDebug m) =>
String
-> NamesT m Type
-> (NamesT m Term -> NamesT m Type)
-> NamesT m Type
nPi' String
"T" (String
-> NamesT (TCMT IO) Term
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall (m :: * -> *).
(MonadAddContext m, HasBuiltins m, MonadDebug m) =>
String
-> NamesT m Term
-> (NamesT m Term -> NamesT m Type)
-> NamesT m Type
pPi' String
"o" NamesT (TCMT IO) Term
φ ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
 -> NamesT (TCMT IO) Type)
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall a b. (a -> b) -> a -> b
$ \ NamesT (TCMT IO) Term
o -> NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Type
el' (TCMT IO Term -> NamesT (TCMT IO) Term
forall (m :: * -> *) a. Monad m => m a -> NamesT m a
cl TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primLevelSuc NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT (TCMT IO) Term
lb) (Sort' Term -> Term
Sort (Sort' Term -> Term) -> (Term -> Sort' Term) -> Term -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term -> Sort' Term
tmSort (Term -> Term) -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamesT (TCMT IO) Term
lb)) ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
 -> NamesT (TCMT IO) Type)
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall a b. (a -> b) -> a -> b
$ \ NamesT (TCMT IO) Term
t ->
       String
-> NamesT (TCMT IO) Term
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall (m :: * -> *).
(MonadAddContext m, HasBuiltins m, MonadDebug m) =>
String
-> NamesT m Term
-> (NamesT m Term -> NamesT m Type)
-> NamesT m Type
pPi' String
"o" NamesT (TCMT IO) Term
φ (\ NamesT (TCMT IO) Term
o -> NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Type
el' (TCMT IO Term -> NamesT (TCMT IO) Term
forall (m :: * -> *) a. Monad m => m a -> NamesT m a
cl TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primLevelMax 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
lb) (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
forall a b. (a -> b) -> a -> b
$ TCMT IO Term -> NamesT (TCMT IO) Term
forall (m :: * -> *) a. Monad m => m a -> NamesT m a
cl TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primEquiv 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
lb 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
t 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
<@> NamesT (TCMT IO) Term
a)
       NamesT (TCMT IO) Type
-> NamesT (TCMT IO) Type -> NamesT (TCMT IO) Type
forall (m :: * -> *). Applicative m => m Type -> m Type -> m Type
--> (Sort' Term -> Type
sort (Sort' Term -> Type) -> (Term -> Sort' Term) -> Term -> Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term -> Sort' Term
tmSort (Term -> Type) -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamesT (TCMT IO) Term
lb))
  Term -> IntervalView
view <- TCMT IO (Term -> IntervalView)
forall (m :: * -> *). HasBuiltins m => m (Term -> IntervalView)
intervalView'
  Term
one <- TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primItIsOne
  PrimitiveImpl -> TCM PrimitiveImpl
forall (m :: * -> *) a. Monad m => a -> m a
return (PrimitiveImpl -> TCM PrimitiveImpl)
-> PrimitiveImpl -> TCM PrimitiveImpl
forall a b. (a -> b) -> a -> b
$ Type -> PrimFun -> PrimitiveImpl
PrimImpl Type
t (PrimFun -> PrimitiveImpl) -> PrimFun -> PrimitiveImpl
forall a b. (a -> b) -> a -> b
$ QName
-> Arity
-> ([Arg Term] -> ReduceM (Reduced MaybeReducedArgs Term))
-> PrimFun
primFun QName
forall a. HasCallStack => a
__IMPOSSIBLE__ Arity
6 (([Arg Term] -> ReduceM (Reduced MaybeReducedArgs Term))
 -> PrimFun)
-> ([Arg Term] -> ReduceM (Reduced MaybeReducedArgs Term))
-> PrimFun
forall a b. (a -> b) -> a -> b
$ \[Arg Term]
ts ->
    case [Arg Term]
ts of
     [Arg Term
la,Arg Term
lb,Arg Term
a,Arg Term
phi,Arg Term
t,Arg Term
e] -> do
       Blocked (Arg Term)
sphi <- Arg Term -> ReduceM (Blocked (Arg Term))
forall t. Reduce t => t -> ReduceM (Blocked t)
reduceB' Arg Term
phi
       case Term -> IntervalView
view (Term -> IntervalView) -> Term -> IntervalView
forall a b. (a -> b) -> a -> b
$ Arg Term -> Term
forall e. Arg e -> e
unArg (Arg Term -> Term) -> Arg Term -> Term
forall a b. (a -> b) -> a -> b
$ Blocked (Arg Term) -> Arg Term
forall t a. Blocked' t a -> a
ignoreBlocking (Blocked (Arg Term) -> Arg Term) -> Blocked (Arg Term) -> Arg Term
forall a b. (a -> b) -> a -> b
$ Blocked (Arg Term)
sphi of
         IntervalView
IOne -> Term -> ReduceM (Reduced MaybeReducedArgs Term)
forall a a'. a -> ReduceM (Reduced a' a)
redReturn (Term -> ReduceM (Reduced MaybeReducedArgs Term))
-> Term -> ReduceM (Reduced MaybeReducedArgs Term)
forall a b. (a -> b) -> a -> b
$ Arg Term -> Term
forall e. Arg e -> e
unArg Arg Term
t Term -> [Arg Term] -> Term
forall t. Apply t => t -> [Arg Term] -> t
`apply` [Term -> Arg Term
forall e. e -> Arg e
argN Term
one]
         IntervalView
_    -> Reduced MaybeReducedArgs Term
-> ReduceM (Reduced MaybeReducedArgs Term)
forall (m :: * -> *) a. Monad m => a -> m a
return (MaybeReducedArgs -> Reduced MaybeReducedArgs Term
forall no yes. no -> Reduced no yes
NoReduction (MaybeReducedArgs -> Reduced MaybeReducedArgs Term)
-> MaybeReducedArgs -> Reduced MaybeReducedArgs Term
forall a b. (a -> b) -> a -> b
$ (Arg Term -> MaybeReduced (Arg Term))
-> [Arg Term] -> MaybeReducedArgs
forall a b. (a -> b) -> [a] -> [b]
map Arg Term -> MaybeReduced (Arg Term)
forall a. a -> MaybeReduced a
notReduced [Arg Term
la,Arg Term
lb,Arg Term
a] MaybeReducedArgs -> MaybeReducedArgs -> MaybeReducedArgs
forall a. [a] -> [a] -> [a]
++ [Blocked (Arg Term) -> MaybeReduced (Arg Term)
reduced Blocked (Arg Term)
sphi] MaybeReducedArgs -> MaybeReducedArgs -> MaybeReducedArgs
forall a. [a] -> [a] -> [a]
++ (Arg Term -> MaybeReduced (Arg Term))
-> [Arg Term] -> MaybeReducedArgs
forall a b. (a -> b) -> [a] -> [b]
map Arg Term -> MaybeReduced (Arg Term)
forall a. a -> MaybeReduced a
notReduced [Arg Term
t,Arg Term
e])
     [Arg Term]
_ -> ReduceM (Reduced MaybeReducedArgs Term)
forall a. HasCallStack => a
__IMPOSSIBLE__

prim_glue' :: TCM PrimitiveImpl
prim_glue' :: TCM PrimitiveImpl
prim_glue' = do
  Cubical -> String -> TCM ()
requireCubical Cubical
CFull String
""
  Type
t <- Names -> NamesT (TCMT IO) Type -> TCMT IO Type
forall (m :: * -> *) a. Names -> NamesT m a -> m a
runNamesT [] (NamesT (TCMT IO) Type -> TCMT IO Type)
-> NamesT (TCMT IO) Type -> TCMT IO Type
forall a b. (a -> b) -> a -> b
$
       String
-> NamesT (TCMT IO) Type
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall (m :: * -> *).
(MonadFail m, MonadAddContext m, MonadDebug m) =>
String
-> NamesT m Type
-> (NamesT m Term -> NamesT m Type)
-> NamesT m Type
hPi' String
"la" (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
forall (m :: * -> *). Functor m => m Term -> m Type
el (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
forall a b. (a -> b) -> a -> b
$ TCMT IO Term -> NamesT (TCMT IO) Term
forall (m :: * -> *) a. Monad m => m a -> NamesT m a
cl TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primLevel) (\ NamesT (TCMT IO) Term
la ->
       String
-> NamesT (TCMT IO) Type
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall (m :: * -> *).
(MonadFail m, MonadAddContext m, MonadDebug m) =>
String
-> NamesT m Type
-> (NamesT m Term -> NamesT m Type)
-> NamesT m Type
hPi' String
"lb" (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
forall (m :: * -> *). Functor m => m Term -> m Type
el (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
forall a b. (a -> b) -> a -> b
$ TCMT IO Term -> NamesT (TCMT IO) Term
forall (m :: * -> *) a. Monad m => m a -> NamesT m a
cl TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primLevel) ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
 -> NamesT (TCMT IO) Type)
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall a b. (a -> b) -> a -> b
$ \ NamesT (TCMT IO) Term
lb ->
       String
-> NamesT (TCMT IO) Type
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall (m :: * -> *).
(MonadFail m, MonadAddContext m, MonadDebug m) =>
String
-> NamesT m Type
-> (NamesT m Term -> NamesT m Type)
-> NamesT m Type
hPi' String
"A" (Sort' Term -> Type
sort (Sort' Term -> Type) -> (Term -> Sort' Term) -> Term -> Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term -> Sort' Term
tmSort (Term -> Type) -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamesT (TCMT IO) Term
la) ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
 -> NamesT (TCMT IO) Type)
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall a b. (a -> b) -> a -> b
$ \ NamesT (TCMT IO) Term
a ->
       String
-> NamesT (TCMT IO) Type
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall (m :: * -> *).
(MonadFail m, MonadAddContext m, MonadDebug m) =>
String
-> NamesT m Type
-> (NamesT m Term -> NamesT m Type)
-> NamesT m Type
hPi' String
"φ" NamesT (TCMT IO) Type
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Type
primIntervalType ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
 -> NamesT (TCMT IO) Type)
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall a b. (a -> b) -> a -> b
$ \ NamesT (TCMT IO) Term
φ ->
       String
-> NamesT (TCMT IO) Type
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall (m :: * -> *).
(MonadFail m, MonadAddContext m, MonadDebug m) =>
String
-> NamesT m Type
-> (NamesT m Term -> NamesT m Type)
-> NamesT m Type
hPi' String
"T" (String
-> NamesT (TCMT IO) Term
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall (m :: * -> *).
(MonadAddContext m, HasBuiltins m, MonadDebug m) =>
String
-> NamesT m Term
-> (NamesT m Term -> NamesT m Type)
-> NamesT m Type
pPi' String
"o" NamesT (TCMT IO) Term
φ ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
 -> NamesT (TCMT IO) Type)
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall a b. (a -> b) -> a -> b
$ \ NamesT (TCMT IO) Term
o ->  NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Type
el' (TCMT IO Term -> NamesT (TCMT IO) Term
forall (m :: * -> *) a. Monad m => m a -> NamesT m a
cl TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primLevelSuc NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT (TCMT IO) Term
lb) (Sort' Term -> Term
Sort (Sort' Term -> Term) -> (Term -> Sort' Term) -> Term -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term -> Sort' Term
tmSort (Term -> Term) -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamesT (TCMT IO) Term
lb)) ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
 -> NamesT (TCMT IO) Type)
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall a b. (a -> b) -> a -> b
$ \ NamesT (TCMT IO) Term
t ->
       String
-> NamesT (TCMT IO) Type
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall (m :: * -> *).
(MonadFail m, MonadAddContext m, MonadDebug m) =>
String
-> NamesT m Type
-> (NamesT m Term -> NamesT m Type)
-> NamesT m Type
hPi' String
"e" (String
-> NamesT (TCMT IO) Term
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall (m :: * -> *).
(MonadAddContext m, HasBuiltins m, MonadDebug m) =>
String
-> NamesT m Term
-> (NamesT m Term -> NamesT m Type)
-> NamesT m Type
pPi' String
"o" NamesT (TCMT IO) Term
φ ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
 -> NamesT (TCMT IO) Type)
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall a b. (a -> b) -> a -> b
$ \ NamesT (TCMT IO) Term
o -> NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Type
el' (TCMT IO Term -> NamesT (TCMT IO) Term
forall (m :: * -> *) a. Monad m => m a -> NamesT m a
cl TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primLevelMax 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
lb) (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
forall a b. (a -> b) -> a -> b
$ TCMT IO Term -> NamesT (TCMT IO) Term
forall (m :: * -> *) a. Monad m => m a -> NamesT m a
cl TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primEquiv 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
lb 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
t 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
<@> NamesT (TCMT IO) Term
a) ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
 -> NamesT (TCMT IO) Type)
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall a b. (a -> b) -> a -> b
$ \ NamesT (TCMT IO) Term
e ->
       String
-> NamesT (TCMT IO) Term
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall (m :: * -> *).
(MonadAddContext m, HasBuiltins m, MonadDebug m) =>
String
-> NamesT m Term
-> (NamesT m Term -> NamesT m Type)
-> NamesT m Type
pPi' String
"o" NamesT (TCMT IO) Term
φ (\ NamesT (TCMT IO) Term
o -> NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Type
el' NamesT (TCMT IO) Term
lb (NamesT (TCMT IO) Term
t 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) Type
-> NamesT (TCMT IO) Type -> NamesT (TCMT IO) Type
forall (m :: * -> *). Applicative m => m Type -> m Type -> m Type
--> (NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Type
el' NamesT (TCMT IO) Term
la NamesT (TCMT IO) Term
a NamesT (TCMT IO) Type
-> NamesT (TCMT IO) Type -> NamesT (TCMT IO) Type
forall (m :: * -> *). Applicative m => m Type -> m Type -> m Type
--> NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Type
el' NamesT (TCMT IO) Term
lb (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
primGlue 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
lb NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT (TCMT IO) Term
a NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> NamesT (TCMT IO) Term
φ 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
t 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
e)))
  Term -> IntervalView
view <- TCMT IO (Term -> IntervalView)
forall (m :: * -> *). HasBuiltins m => m (Term -> IntervalView)
intervalView'
  Term
one <- TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primItIsOne
  PrimitiveImpl -> TCM PrimitiveImpl
forall (m :: * -> *) a. Monad m => a -> m a
return (PrimitiveImpl -> TCM PrimitiveImpl)
-> PrimitiveImpl -> TCM PrimitiveImpl
forall a b. (a -> b) -> a -> b
$ Type -> PrimFun -> PrimitiveImpl
PrimImpl Type
t (PrimFun -> PrimitiveImpl) -> PrimFun -> PrimitiveImpl
forall a b. (a -> b) -> a -> b
$ QName
-> Arity
-> ([Arg Term] -> ReduceM (Reduced MaybeReducedArgs Term))
-> PrimFun
primFun QName
forall a. HasCallStack => a
__IMPOSSIBLE__ Arity
8 (([Arg Term] -> ReduceM (Reduced MaybeReducedArgs Term))
 -> PrimFun)
-> ([Arg Term] -> ReduceM (Reduced MaybeReducedArgs Term))
-> PrimFun
forall a b. (a -> b) -> a -> b
$ \[Arg Term]
ts ->
    case [Arg Term]
ts of
      [Arg Term
la,Arg Term
lb,Arg Term
bA,Arg Term
phi,Arg Term
bT,Arg Term
e,Arg Term
t,Arg Term
a] -> do
       Blocked (Arg Term)
sphi <- Arg Term -> ReduceM (Blocked (Arg Term))
forall t. Reduce t => t -> ReduceM (Blocked t)
reduceB' Arg Term
phi
       case Term -> IntervalView
view (Term -> IntervalView) -> Term -> IntervalView
forall a b. (a -> b) -> a -> b
$ Arg Term -> Term
forall e. Arg e -> e
unArg (Arg Term -> Term) -> Arg Term -> Term
forall a b. (a -> b) -> a -> b
$ Blocked (Arg Term) -> Arg Term
forall t a. Blocked' t a -> a
ignoreBlocking (Blocked (Arg Term) -> Arg Term) -> Blocked (Arg Term) -> Arg Term
forall a b. (a -> b) -> a -> b
$ Blocked (Arg Term)
sphi of
         IntervalView
IOne -> Term -> ReduceM (Reduced MaybeReducedArgs Term)
forall a a'. a -> ReduceM (Reduced a' a)
redReturn (Term -> ReduceM (Reduced MaybeReducedArgs Term))
-> Term -> ReduceM (Reduced MaybeReducedArgs Term)
forall a b. (a -> b) -> a -> b
$ Arg Term -> Term
forall e. Arg e -> e
unArg Arg Term
t Term -> [Arg Term] -> Term
forall t. Apply t => t -> [Arg Term] -> t
`apply` [Term -> Arg Term
forall e. e -> Arg e
argN Term
one]
         IntervalView
_    -> Reduced MaybeReducedArgs Term
-> ReduceM (Reduced MaybeReducedArgs Term)
forall (m :: * -> *) a. Monad m => a -> m a
return (MaybeReducedArgs -> Reduced MaybeReducedArgs Term
forall no yes. no -> Reduced no yes
NoReduction (MaybeReducedArgs -> Reduced MaybeReducedArgs Term)
-> MaybeReducedArgs -> Reduced MaybeReducedArgs Term
forall a b. (a -> b) -> a -> b
$ (Arg Term -> MaybeReduced (Arg Term))
-> [Arg Term] -> MaybeReducedArgs
forall a b. (a -> b) -> [a] -> [b]
map Arg Term -> MaybeReduced (Arg Term)
forall a. a -> MaybeReduced a
notReduced [Arg Term
la,Arg Term
lb,Arg Term
bA] MaybeReducedArgs -> MaybeReducedArgs -> MaybeReducedArgs
forall a. [a] -> [a] -> [a]
++ [Blocked (Arg Term) -> MaybeReduced (Arg Term)
reduced Blocked (Arg Term)
sphi] MaybeReducedArgs -> MaybeReducedArgs -> MaybeReducedArgs
forall a. [a] -> [a] -> [a]
++ (Arg Term -> MaybeReduced (Arg Term))
-> [Arg Term] -> MaybeReducedArgs
forall a b. (a -> b) -> [a] -> [b]
map Arg Term -> MaybeReduced (Arg Term)
forall a. a -> MaybeReduced a
notReduced [Arg Term
bT,Arg Term
e,Arg Term
t,Arg Term
a])
      [Arg Term]
_ -> ReduceM (Reduced MaybeReducedArgs Term)
forall a. HasCallStack => a
__IMPOSSIBLE__

prim_unglue' :: TCM PrimitiveImpl
prim_unglue' :: TCM PrimitiveImpl
prim_unglue' = do
  Cubical -> String -> TCM ()
requireCubical Cubical
CFull String
""
  Type
t <- Names -> NamesT (TCMT IO) Type -> TCMT IO Type
forall (m :: * -> *) a. Names -> NamesT m a -> m a
runNamesT [] (NamesT (TCMT IO) Type -> TCMT IO Type)
-> NamesT (TCMT IO) Type -> TCMT IO Type
forall a b. (a -> b) -> a -> b
$
       String
-> NamesT (TCMT IO) Type
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall (m :: * -> *).
(MonadFail m, MonadAddContext m, MonadDebug m) =>
String
-> NamesT m Type
-> (NamesT m Term -> NamesT m Type)
-> NamesT m Type
hPi' String
"la" (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
forall (m :: * -> *). Functor m => m Term -> m Type
el (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
forall a b. (a -> b) -> a -> b
$ TCMT IO Term -> NamesT (TCMT IO) Term
forall (m :: * -> *) a. Monad m => m a -> NamesT m a
cl TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primLevel) (\ NamesT (TCMT IO) Term
la ->
       String
-> NamesT (TCMT IO) Type
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall (m :: * -> *).
(MonadFail m, MonadAddContext m, MonadDebug m) =>
String
-> NamesT m Type
-> (NamesT m Term -> NamesT m Type)
-> NamesT m Type
hPi' String
"lb" (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
forall (m :: * -> *). Functor m => m Term -> m Type
el (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
forall a b. (a -> b) -> a -> b
$ TCMT IO Term -> NamesT (TCMT IO) Term
forall (m :: * -> *) a. Monad m => m a -> NamesT m a
cl TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primLevel) ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
 -> NamesT (TCMT IO) Type)
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall a b. (a -> b) -> a -> b
$ \ NamesT (TCMT IO) Term
lb ->
       String
-> NamesT (TCMT IO) Type
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall (m :: * -> *).
(MonadFail m, MonadAddContext m, MonadDebug m) =>
String
-> NamesT m Type
-> (NamesT m Term -> NamesT m Type)
-> NamesT m Type
hPi' String
"A" (Sort' Term -> Type
sort (Sort' Term -> Type) -> (Term -> Sort' Term) -> Term -> Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term -> Sort' Term
tmSort (Term -> Type) -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamesT (TCMT IO) Term
la) ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
 -> NamesT (TCMT IO) Type)
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall a b. (a -> b) -> a -> b
$ \ NamesT (TCMT IO) Term
a ->
       String
-> NamesT (TCMT IO) Type
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall (m :: * -> *).
(MonadFail m, MonadAddContext m, MonadDebug m) =>
String
-> NamesT m Type
-> (NamesT m Term -> NamesT m Type)
-> NamesT m Type
hPi' String
"φ" NamesT (TCMT IO) Type
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Type
primIntervalType ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
 -> NamesT (TCMT IO) Type)
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall a b. (a -> b) -> a -> b
$ \ NamesT (TCMT IO) Term
φ ->
       String
-> NamesT (TCMT IO) Type
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall (m :: * -> *).
(MonadFail m, MonadAddContext m, MonadDebug m) =>
String
-> NamesT m Type
-> (NamesT m Term -> NamesT m Type)
-> NamesT m Type
hPi' String
"T" (String
-> NamesT (TCMT IO) Term
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall (m :: * -> *).
(MonadAddContext m, HasBuiltins m, MonadDebug m) =>
String
-> NamesT m Term
-> (NamesT m Term -> NamesT m Type)
-> NamesT m Type
pPi' String
"o" NamesT (TCMT IO) Term
φ ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
 -> NamesT (TCMT IO) Type)
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall a b. (a -> b) -> a -> b
$ \ NamesT (TCMT IO) Term
o ->  NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Type
el' (TCMT IO Term -> NamesT (TCMT IO) Term
forall (m :: * -> *) a. Monad m => m a -> NamesT m a
cl TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primLevelSuc NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT (TCMT IO) Term
lb) (Sort' Term -> Term
Sort (Sort' Term -> Term) -> (Term -> Sort' Term) -> Term -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term -> Sort' Term
tmSort (Term -> Term) -> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamesT (TCMT IO) Term
lb)) ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
 -> NamesT (TCMT IO) Type)
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall a b. (a -> b) -> a -> b
$ \ NamesT (TCMT IO) Term
t ->
       String
-> NamesT (TCMT IO) Type
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall (m :: * -> *).
(MonadFail m, MonadAddContext m, MonadDebug m) =>
String
-> NamesT m Type
-> (NamesT m Term -> NamesT m Type)
-> NamesT m Type
hPi' String
"e" (String
-> NamesT (TCMT IO) Term
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall (m :: * -> *).
(MonadAddContext m, HasBuiltins m, MonadDebug m) =>
String
-> NamesT m Term
-> (NamesT m Term -> NamesT m Type)
-> NamesT m Type
pPi' String
"o" NamesT (TCMT IO) Term
φ ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
 -> NamesT (TCMT IO) Type)
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall a b. (a -> b) -> a -> b
$ \ NamesT (TCMT IO) Term
o -> NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Type
el' (TCMT IO Term -> NamesT (TCMT IO) Term
forall (m :: * -> *) a. Monad m => m a -> NamesT m a
cl TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primLevelMax 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
lb) (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
forall a b. (a -> b) -> a -> b
$ TCMT IO Term -> NamesT (TCMT IO) Term
forall (m :: * -> *) a. Monad m => m a -> NamesT m a
cl TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primEquiv 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
lb 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
t 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
<@> NamesT (TCMT IO) Term
a) ((NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
 -> NamesT (TCMT IO) Type)
-> (NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type)
-> NamesT (TCMT IO) Type
forall a b. (a -> b) -> a -> b
$ \ NamesT (TCMT IO) Term
e ->
       (NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Type
el' NamesT (TCMT IO) Term
lb (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
primGlue 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
lb NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT (TCMT IO) Term
a NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> NamesT (TCMT IO) Term
φ 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
t 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
e)) NamesT (TCMT IO) Type
-> NamesT (TCMT IO) Type -> NamesT (TCMT IO) Type
forall (m :: * -> *). Applicative m => m Type -> m Type -> m Type
--> NamesT (TCMT IO) Term
-> NamesT (TCMT IO) Term -> NamesT (TCMT IO) Type
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Type
el' NamesT (TCMT IO) Term
la NamesT (TCMT IO) Term
a)
  Term -> IntervalView
view <- TCMT IO (Term -> IntervalView)
forall (m :: * -> *). HasBuiltins m => m (Term -> IntervalView)
intervalView'
  Term
one <- TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primItIsOne
  Maybe QName
mGlue <- String -> TCMT IO (Maybe QName)
forall (m :: * -> *). HasBuiltins m => String -> m (Maybe QName)
getPrimitiveName' String
builtinGlue
  Maybe QName
mglue <- String -> TCMT IO (Maybe QName)
forall (m :: * -> *). HasBuiltins m => String -> m (Maybe QName)
getPrimitiveName' String
builtin_glue
  Maybe QName
mtransp <- String -> TCMT IO (Maybe QName)
forall (m :: * -> *). HasBuiltins m => String -> m (Maybe QName)
getPrimitiveName' String
builtinTrans
  Maybe QName
mhcomp <- String -> TCMT IO (Maybe QName)
forall (m :: * -> *). HasBuiltins m => String -> m (Maybe QName)
getPrimitiveName' String
builtinHComp
  PrimitiveImpl -> TCM PrimitiveImpl
forall (m :: * -> *) a. Monad m => a -> m a
return (PrimitiveImpl -> TCM PrimitiveImpl)
-> PrimitiveImpl -> TCM PrimitiveImpl
forall a b. (a -> b) -> a -> b
$ Type -> PrimFun -> PrimitiveImpl
PrimImpl Type
t (PrimFun -> PrimitiveImpl) -> PrimFun -> PrimitiveImpl
forall a b. (a -> b) -> a -> b
$ QName
-> Arity
-> ([Arg Term] -> ReduceM (Reduced MaybeReducedArgs Term))
-> PrimFun
primFun QName
forall a. HasCallStack => a
__IMPOSSIBLE__ Arity
7 (([Arg Term] -> ReduceM (Reduced MaybeReducedArgs Term))
 -> PrimFun)
-> ([Arg Term] -> ReduceM (Reduced MaybeReducedArgs Term))
-> PrimFun
forall a b. (a -> b) -> a -> b
$ \[Arg Term]
ts ->
    case [Arg Term]
ts of
      [Arg Term
la,Arg Term
lb,Arg Term
bA,Arg Term
phi,Arg Term
bT,Arg Term
e,Arg Term
b] -> do
       Blocked (Arg Term)
sphi <- Arg Term -> ReduceM (Blocked (Arg Term))
forall t. Reduce t => t -> ReduceM (Blocked t)
reduceB' Arg Term
phi
       case Term -> IntervalView
view (Term -> IntervalView) -> Term -> IntervalView
forall a b. (a -> b) -> a -> b
$ Arg Term -> Term
forall e. Arg e -> e
unArg (Arg Term -> Term) -> Arg Term -> Term
forall a b. (a -> b) -> a -> b
$ Blocked (Arg Term) -> Arg Term
forall t a. Blocked' t a -> a
ignoreBlocking (Blocked (Arg Term) -> Arg Term) -> Blocked (Arg Term) -> Arg Term
forall a b. (a -> b) -> a -> b
$ Blocked (Arg Term)
sphi of
         IntervalView
IOne -> do
           let argOne :: Arg Term
argOne = Relevance -> Arg Term -> Arg Term
forall a. LensRelevance a => Relevance -> a -> a
setRelevance Relevance
Irrelevant (Arg Term -> Arg Term) -> Arg Term -> Arg Term
forall a b. (a -> b) -> a -> b
$ Term -> Arg Term
forall e. e -> Arg e
argN Term
one
           Term
tEFun <- String -> String -> ReduceM Term
forall (m :: * -> *). HasBuiltins m => String -> String -> m Term
getTerm String
builtin_unglue String
builtinEquivFun
           Term -> ReduceM (Reduced MaybeReducedArgs Term)
forall a a'. a -> ReduceM (Reduced a' a)
redReturn (Term -> ReduceM (Reduced MaybeReducedArgs Term))
-> Term -> ReduceM (Reduced MaybeReducedArgs Term)
forall a b. (a -> b) -> a -> b
$ Term
tEFun Term -> [Arg Term] -> Term
forall t. Apply t => t -> [Arg Term] -> t
`apply` [Arg Term
lb,Arg Term
la,Term -> Arg Term
forall e. e -> Arg e
argH (Term -> Arg Term) -> Term -> Arg Term
forall a b. (a -> b) -> a -> b
$ Arg Term -> Term
forall e. Arg e -> e
unArg Arg Term
bT Term -> [Arg Term] -> Term
forall t. Apply t => t -> [Arg Term] -> t
`apply` [Arg Term
argOne],Arg Term
bA, Term -> Arg Term
forall e. e -> Arg e
argN (Term -> Arg Term) -> Term -> Arg Term
forall a b. (a -> b) -> a -> b
$ Arg Term -> Term
forall e. Arg e -> e
unArg Arg Term
e Term -> [Arg Term] -> Term
forall t. Apply t => t -> [Arg Term] -> t
`apply` [Arg Term
argOne],Arg Term
b]
         IntervalView
_    -> do
            Blocked (Arg Term)
sb <- Arg Term -> ReduceM (Blocked (Arg Term))
forall t. Reduce t => t -> ReduceM (Blocked t)
reduceB' Arg Term
b
            let fallback :: Blocked (Arg Term) -> ReduceM (Reduced MaybeReducedArgs Term)
fallback Blocked (Arg Term)
sbA = Reduced MaybeReducedArgs Term
-> ReduceM (Reduced MaybeReducedArgs Term)
forall (m :: * -> *) a. Monad m => a -> m a
return (MaybeReducedArgs -> Reduced MaybeReducedArgs Term
forall no yes. no -> Reduced no yes
NoReduction (MaybeReducedArgs -> Reduced MaybeReducedArgs Term)
-> MaybeReducedArgs -> Reduced MaybeReducedArgs Term
forall a b. (a -> b) -> a -> b
$ (Arg Term -> MaybeReduced (Arg Term))
-> [Arg Term] -> MaybeReducedArgs
forall a b. (a -> b) -> [a] -> [b]
map Arg Term -> MaybeReduced (Arg Term)
forall a. a -> MaybeReduced a
notReduced [Arg Term
la,Arg Term
lb] MaybeReducedArgs -> MaybeReducedArgs -> MaybeReducedArgs
forall a. [a] -> [a] -> [a]
++ (Blocked (Arg Term) -> MaybeReduced (Arg Term))
-> [Blocked (Arg Term)] -> MaybeReducedArgs
forall a b. (a -> b) -> [a] -> [b]
map Blocked (Arg Term) -> MaybeReduced (Arg Term)
reduced [Blocked (Arg Term)
sbA, Blocked (Arg Term)
sphi] MaybeReducedArgs -> MaybeReducedArgs -> MaybeReducedArgs
forall a. [a] -> [a] -> [a]
++ (Arg Term -> MaybeReduced (Arg Term))
-> [Arg Term] -> MaybeReducedArgs
forall a b. (a -> b) -> [a] -> [b]
map Arg Term -> MaybeReduced (Arg Term)
forall a. a -> MaybeReduced a
notReduced [Arg Term
bT,Arg Term
e] MaybeReducedArgs -> MaybeReducedArgs -> MaybeReducedArgs
forall a. [a] -> [a] -> [a]
++ [Blocked (Arg Term) -> MaybeReduced (Arg Term)
reduced Blocked (Arg Term)
sb])
            case Arg Term -> Term
forall e. Arg e -> e
unArg (Arg Term -> Term) -> Arg Term -> Term
forall a b. (a -> b) -> a -> b
$ Blocked (Arg Term) -> Arg Term
forall t a. Blocked' t a -> a
ignoreBlocking (Blocked (Arg Term) -> Arg Term) -> Blocked (Arg Term) -> Arg Term
forall a b. (a -> b) -> a -> b
$ Blocked (Arg Term)
sb of
               Def QName
q [Apply Arg Term
_,Apply Arg Term
_,Apply Arg Term
_,Apply Arg Term
_,Apply Arg Term
_,Apply Arg Term
_,Apply Arg Term
_,Apply Arg Term
a]
                     | QName -> Maybe QName
forall a. a -> Maybe a
Just QName
q Maybe QName -> Maybe QName -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe QName
mglue -> Term -> ReduceM (Reduced MaybeReducedArgs Term)
forall a a'. a -> ReduceM (Reduced a' a)
redReturn (Term -> ReduceM (Reduced MaybeReducedArgs Term))
-> Term -> ReduceM (Reduced MaybeReducedArgs Term)
forall a b. (a -> b) -> a -> b
$ Arg Term -> Term
forall e. Arg e -> e
unArg Arg Term
a
               Def QName
q [Apply Arg Term
l,Apply Arg Term
bA,Apply Arg Term
r,Apply Arg Term
u0]
                     | QName -> Maybe QName
forall a. a -> Maybe a
Just QName
q Maybe QName -> Maybe QName -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe QName
mtransp -> do
                 Blocked (Arg Term)
sbA <- Arg Term -> ReduceM (Blocked (Arg Term))
forall t. Reduce t => t -> ReduceM (Blocked t)
reduceB' Arg Term
bA
                 case Arg Term -> Term
forall e. Arg e -> e
unArg (Arg Term -> Term) -> Arg Term -> Term
forall a b. (a -> b) -> a -> b
$ Blocked (Arg Term) -> Arg Term
forall t a. Blocked' t a -> a
ignoreBlocking Blocked (Arg Term)
sbA of
                   Lam ArgInfo
_ Abs Term
t -> do
                     Blocked' Term Term
st <- Term -> ReduceM (Blocked' Term Term)
forall t. Reduce t => t -> ReduceM (Blocked t)
reduceB' (Abs Term -> Term
forall a. Subst a => Abs a -> a
absBody Abs Term
t)
                     case Blocked' Term Term -> Term
forall t a. Blocked' t a -> a
ignoreBlocking Blocked' Term Term
st of
                       Def QName
g [Elim]
es | Just [Arg Term
la',Arg Term
lb',Arg Term
bA',Arg Term
phi',Arg Term
bT',Arg Term
e'] <- [Elim] -> Maybe [Arg Term]
forall a. [Elim' a] -> Maybe [Arg a]
allApplyElims [Elim]
es, QName -> Maybe QName
forall a. a -> Maybe a
Just QName
g Maybe QName -> Maybe QName -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe QName
mGlue -> do
                           Term -> ReduceM (Reduced MaybeReducedArgs Term)
forall a a'. a -> ReduceM (Reduced a' a)
redReturn (Term -> ReduceM (Reduced MaybeReducedArgs Term))
-> (Maybe Term -> Term)
-> Maybe Term
-> ReduceM (Reduced MaybeReducedArgs Term)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term -> Maybe Term -> Term
forall a. a -> Maybe a -> a
fromMaybe Term
forall a. HasCallStack => a
__IMPOSSIBLE__ (Maybe Term -> ReduceM (Reduced MaybeReducedArgs Term))
-> ReduceM (Maybe Term) -> ReduceM (Reduced MaybeReducedArgs Term)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< TranspOrHComp
-> Arg Term
-> Maybe (Arg Term)
-> Arg Term
-> FamilyOrNot
     (Arg Term, Arg Term, Arg Term, Arg Term, Arg Term, Arg Term)
-> TermPosition
-> ReduceM (Maybe Term)
forall (m :: * -> *).
PureTCM m =>
TranspOrHComp
-> Arg Term
-> Maybe (Arg Term)
-> Arg Term
-> FamilyOrNot
     (Arg Term, Arg Term, Arg Term, Arg Term, Arg Term, Arg Term)
-> TermPosition
-> m (Maybe Term)
compGlue TranspOrHComp
DoTransp Arg Term
r Maybe (Arg Term)
forall a. Maybe a
Nothing Arg Term
u0 ((Arg Term, Arg Term, Arg Term, Arg Term, Arg Term, Arg Term)
-> FamilyOrNot
     (Arg Term, Arg Term, Arg Term, Arg Term, Arg Term, Arg Term)
forall a. a -> FamilyOrNot a
IsFam (Arg Term
la',Arg Term
lb',Arg Term
bA',Arg Term
phi',Arg Term
bT',Arg Term
e')) TermPosition
Eliminated
                       Term
_ -> Blocked (Arg Term) -> ReduceM (Reduced MaybeReducedArgs Term)
fallback (Blocked' Term Term
st Blocked' Term Term -> Blocked (Arg Term) -> Blocked (Arg Term)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Blocked (Arg Term)
sbA)
                   Term
_ -> Blocked (Arg Term) -> ReduceM (Reduced MaybeReducedArgs Term)
fallback Blocked (Arg Term)
sbA
               Def QName
q [Apply Arg Term
l,Apply Arg Term
bA,Apply Arg Term
r,Apply Arg Term
u,Apply Arg Term
u0]
                     | QName -> Maybe QName
forall a. a -> Maybe a
Just QName
q Maybe QName -> Maybe QName -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe QName
mhcomp -> do
                 Blocked (Arg Term)
sbA <- Arg Term -> ReduceM (Blocked (Arg Term))
forall t. Reduce t => t -> ReduceM (Blocked t)
reduceB' Arg Term
bA
                 case Arg Term -> Term
forall e. Arg e -> e
unArg (Arg Term -> Term) -> Arg Term -> Term
forall a b. (a -> b) -> a -> b
$ Blocked (Arg Term) -> Arg Term
forall t a. Blocked' t a -> a
ignoreBlocking Blocked (Arg Term)
sbA of
                   Def QName
g [Elim]
es | Just [Arg Term
la',Arg Term
lb',Arg Term
bA',Arg Term
phi',Arg Term
bT',Arg Term
e'] <- [Elim] -> Maybe [Arg Term]
forall a. [Elim' a] -> Maybe [Arg a]
allApplyElims [Elim]
es, QName -> Maybe QName
forall a. a -> Maybe a
Just QName
g Maybe QName -> Maybe QName -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe QName
mGlue -> do
                       Term -> ReduceM (Reduced MaybeReducedArgs Term)
forall a a'. a -> ReduceM (Reduced a' a)
redReturn (Term -> ReduceM (Reduced MaybeReducedArgs Term))
-> (Maybe Term -> Term)
-> Maybe Term
-> ReduceM (Reduced MaybeReducedArgs Term)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term -> Maybe Term -> Term
forall a. a -> Maybe a -> a
fromMaybe Term
forall a. HasCallStack => a
__IMPOSSIBLE__ (Maybe Term -> ReduceM (Reduced MaybeReducedArgs Term))
-> ReduceM (Maybe Term) -> ReduceM (Reduced MaybeReducedArgs Term)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< TranspOrHComp
-> Arg Term
-> Maybe (Arg Term)
-> Arg Term
-> FamilyOrNot
     (Arg Term, Arg Term, Arg Term, Arg Term, Arg Term, Arg Term)
-> TermPosition
-> ReduceM (Maybe Term)
forall (m :: * -> *).
PureTCM m =>
TranspOrHComp
-> Arg Term
-> Maybe (Arg Term)
-> Arg Term
-> FamilyOrNot
     (Arg Term, Arg Term, Arg Term, Arg Term, Arg Term, Arg Term)
-> TermPosition
-> m (Maybe Term)
compGlue TranspOrHComp
DoHComp Arg Term
r (Arg Term -> Maybe (Arg Term)
forall a. a -> Maybe a
Just Arg Term
u) Arg Term
u0 ((Arg Term, Arg Term, Arg Term, Arg Term, Arg Term, Arg Term)
-> FamilyOrNot
     (Arg Term, Arg Term, Arg Term, Arg Term, Arg Term, Arg Term)
forall a. a -> FamilyOrNot a
IsNot (Arg Term
la',Arg Term
lb',Arg Term
bA',Arg Term
phi',Arg Term
bT',Arg Term
e')) TermPosition
Eliminated
                   Term
_ -> Blocked (Arg Term) -> ReduceM (Reduced MaybeReducedArgs Term)
fallback Blocked (Arg Term)
sbA
               Term
_ -> Reduced MaybeReducedArgs Term
-> ReduceM (Reduced MaybeReducedArgs Term)
forall (m :: * -> *) a. Monad m => a -> m a
return (MaybeReducedArgs -> Reduced MaybeReducedArgs Term
forall no yes. no -> Reduced no yes
NoReduction (MaybeReducedArgs -> Reduced MaybeReducedArgs Term)
-> MaybeReducedArgs -> Reduced MaybeReducedArgs Term
forall a b. (a -> b) -> a -> b
$ (Arg Term -> MaybeReduced (Arg Term))
-> [Arg Term] -> MaybeReducedArgs
forall a b. (a -> b) -> [a] -> [b]
map Arg Term -> MaybeReduced (Arg Term)
forall a. a -> MaybeReduced a
notReduced [Arg Term
la,Arg Term
lb,Arg Term
bA] MaybeReducedArgs -> MaybeReducedArgs -> MaybeReducedArgs
forall a. [a] -> [a] -> [a]
++ [Blocked (Arg Term) -> MaybeReduced (Arg Term)
reduced Blocked (Arg Term)
sphi] MaybeReducedArgs -> MaybeReducedArgs -> MaybeReducedArgs
forall a. [a] -> [a] -> [a]
++ (Arg Term -> MaybeReduced (Arg Term))
-> [Arg Term] -> MaybeReducedArgs
forall a b. (a -> b) -> [a] -> [b]
map Arg Term -> MaybeReduced (Arg Term)
forall a. a -> MaybeReduced a
notReduced [Arg Term
bT,Arg Term
e] MaybeReducedArgs -> MaybeReducedArgs -> MaybeReducedArgs
forall a. [a] -> [a] -> [a]
++ [Blocked (Arg Term) -> MaybeReduced (Arg Term)
reduced Blocked (Arg Term)
sb])
      [Arg Term]
_ -> ReduceM (Reduced MaybeReducedArgs Term)
forall a. HasCallStack => a
__IMPOSSIBLE__


-- TODO Andrea: keep reductions that happen under foralls?
primFaceForall' :: TCM PrimitiveImpl
primFaceForall' :: TCM PrimitiveImpl
primFaceForall' = do
  Cubical -> String -> TCM ()
requireCubical Cubical
CErased String
""
  Type
t <- (TCMT IO Type
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Type
primIntervalType TCMT IO Type -> TCMT IO Type -> TCMT IO Type
forall (m :: * -> *). Applicative m => m Type -> m Type -> m Type
--> TCMT IO Type
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Type
primIntervalType) TCMT IO Type -> TCMT IO Type -> TCMT IO Type
forall (m :: * -> *). Applicative m => m Type -> m Type -> m Type
--> TCMT IO Type
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Type
primIntervalType
  PrimitiveImpl -> TCM PrimitiveImpl
forall (m :: * -> *) a. Monad m => a -> m a
return (PrimitiveImpl -> TCM PrimitiveImpl)
-> PrimitiveImpl -> TCM PrimitiveImpl
forall a b. (a -> b) -> a -> b
$ Type -> PrimFun -> PrimitiveImpl
PrimImpl Type
t (PrimFun -> PrimitiveImpl) -> PrimFun -> PrimitiveImpl
forall a b. (a -> b) -> a -> b
$ QName
-> Arity
-> ([Arg Term] -> ReduceM (Reduced MaybeReducedArgs Term))
-> PrimFun
primFun QName
forall a. HasCallStack => a
__IMPOSSIBLE__ Arity
1 (([Arg Term] -> ReduceM (Reduced MaybeReducedArgs Term))
 -> PrimFun)
-> ([Arg Term] -> ReduceM (Reduced MaybeReducedArgs Term))
-> PrimFun
forall a b. (a -> b) -> a -> b
$ \[Arg Term]
ts -> case [Arg Term]
ts of
    [Arg Term
phi] -> do
      Blocked (Arg Term)
sphi <- Arg Term -> ReduceM (Blocked (Arg Term))
forall t. Reduce t => t -> ReduceM (Blocked t)
reduceB' Arg Term
phi
      case Arg Term -> Term
forall e. Arg e -> e
unArg (Arg Term -> Term) -> Arg Term -> Term
forall a b. (a -> b) -> a -> b
$ Blocked (Arg Term) -> Arg Term
forall t a. Blocked' t a -> a
ignoreBlocking (Blocked (Arg Term) -> Arg Term) -> Blocked (Arg Term) -> Arg Term
forall a b. (a -> b) -> a -> b
$ Blocked (Arg Term)
sphi of
        Lam ArgInfo
_ Abs Term
t -> do
          Abs Term
t <- Abs Term -> ReduceM (Abs Term)
forall t. Reduce t => t -> ReduceM t
reduce' Abs Term
t
          case Abs Term
t of
            NoAbs String
_ Term
t -> Term -> ReduceM (Reduced MaybeReducedArgs Term)
forall a a'. a -> ReduceM (Reduced a' a)
redReturn Term
t
            Abs String
_ Term
t ->
              ReduceM (Reduced MaybeReducedArgs Term)
-> (Term -> ReduceM (Reduced MaybeReducedArgs Term))
-> Maybe Term
-> ReduceM (Reduced MaybeReducedArgs Term)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Reduced MaybeReducedArgs Term
-> ReduceM (Reduced MaybeReducedArgs Term)
forall (m :: * -> *) a. Monad m => a -> m a
return (Reduced MaybeReducedArgs Term
 -> ReduceM (Reduced MaybeReducedArgs Term))
-> Reduced MaybeReducedArgs Term
-> ReduceM (Reduced MaybeReducedArgs Term)
forall a b. (a -> b) -> a -> b
$ MaybeReducedArgs -> Reduced MaybeReducedArgs Term
forall no yes. no -> Reduced no yes
NoReduction [Blocked (Arg Term) -> MaybeReduced (Arg Term)
reduced Blocked (Arg Term)
sphi]) Term -> ReduceM (Reduced MaybeReducedArgs Term)
forall a a'. a -> ReduceM (Reduced a' a)
redReturn
                (Maybe Term -> ReduceM (Reduced MaybeReducedArgs Term))
-> ReduceM (Maybe Term) -> ReduceM (Reduced MaybeReducedArgs Term)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Term -> ReduceM (Maybe Term)
forall (m :: * -> *). HasBuiltins m => Term -> m (Maybe Term)
toFaceMapsPrim Term
t
        Term
_ -> Reduced MaybeReducedArgs Term
-> ReduceM (Reduced MaybeReducedArgs Term)
forall (m :: * -> *) a. Monad m => a -> m a
return (MaybeReducedArgs -> Reduced MaybeReducedArgs Term
forall no yes. no -> Reduced no yes
NoReduction [Blocked (Arg Term) -> MaybeReduced (Arg Term)
reduced Blocked (Arg Term)
sphi])
    [Arg Term]
_ -> ReduceM (Reduced MaybeReducedArgs Term)
forall a. HasCallStack => a
__IMPOSSIBLE__
  where
    toFaceMapsPrim :: Term -> m (Maybe Term)
toFaceMapsPrim Term
t = do
      Term -> IntervalView
view <- m (Term -> IntervalView)
forall (m :: * -> *). HasBuiltins m => m (Term -> IntervalView)
intervalView'
      IntervalView -> Term
unview <- m (IntervalView -> Term)
forall (m :: * -> *). HasBuiltins m => m (IntervalView -> Term)
intervalUnview'
      [(Map Arity Bool, [Term])]
us' <- Term -> m [(Map Arity Bool, [Term])]
forall (m :: * -> *).
HasBuiltins m =>
Term -> m [(Map Arity Bool, [Term])]
decomposeInterval Term
t
      Term
fr <- String -> String -> m Term
forall (m :: * -> *). HasBuiltins m => String -> String -> m Term
getTerm String
builtinFaceForall String
builtinFaceForall
      let v :: IntervalView
v = Term -> IntervalView
view Term
t
          us :: [[Either (Arity, Bool) Term]]
us =
            [ ((Arity, Bool) -> Either (Arity, Bool) Term)
-> [(Arity, Bool)] -> [Either (Arity, Bool) Term]
forall a b. (a -> b) -> [a] -> [b]
map (Arity, Bool) -> Either (Arity, Bool) Term
forall a b. a -> Either a b
Left (Map Arity Bool -> [(Arity, Bool)]
forall k a. Map k a -> [(k, a)]
Map.toList Map Arity Bool
bsm) [Either (Arity, Bool) Term]
-> [Either (Arity, Bool) Term] -> [Either (Arity, Bool) Term]
forall a. [a] -> [a] -> [a]
++ (Term -> Either (Arity, Bool) Term)
-> [Term] -> [Either (Arity, Bool) Term]
forall a b. (a -> b) -> [a] -> [b]
map Term -> Either (Arity, Bool) Term
forall a b. b -> Either a b
Right [Term]
ts
              | (Map Arity Bool
bsm, [Term]
ts) <- [(Map Arity Bool, [Term])]
us',
                Arity
0 Arity -> Map Arity Bool -> Bool
forall k a. Ord k => k -> Map k a -> Bool
`Map.notMember` Map Arity Bool
bsm
            ]
          fm :: (Arity, Bool) -> Term
fm (Arity
i, Bool
b) = if Bool
b then Arity -> Term
var (Arity
i Arity -> Arity -> Arity
forall a. Num a => a -> a -> a
- Arity
1) else IntervalView -> Term
unview (Arg Term -> IntervalView
INeg (Term -> Arg Term
forall e. e -> Arg e
argN (Arity -> Term
var (Arity -> Term) -> Arity -> Term
forall a b. (a -> b) -> a -> b
$ Arity
i Arity -> Arity -> Arity
forall a. Num a => a -> a -> a
- Arity
1)))
          ffr :: Term -> Term
ffr Term
t = Term
fr Term -> [Arg Term] -> Term
forall t. Apply t => t -> [Arg Term] -> t
`apply` [Term -> Arg Term
forall e. e -> Arg e
argN (Term -> Arg Term) -> Term -> Arg Term
forall a b. (a -> b) -> a -> b
$ ArgInfo -> Abs Term -> Term
Lam ArgInfo
defaultArgInfo (Abs Term -> Term) -> Abs Term -> Term
forall a b. (a -> b) -> a -> b
$ String -> Term -> Abs Term
forall a. String -> a -> Abs a
Abs String
"i" Term
t]
          r :: Maybe Term
r =
            Term -> Maybe Term
forall a. a -> Maybe a
Just (Term -> Maybe Term) -> Term -> Maybe Term
forall a b. (a -> b) -> a -> b
$
              ([Either (Arity, Bool) Term] -> Term -> Term)
-> Term -> [[Either (Arity, Bool) Term]] -> Term
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
                ( (\Term
x Term
r -> IntervalView -> Term
unview (Arg Term -> Arg Term -> IntervalView
IMax (Term -> Arg Term
forall e. e -> Arg e
argN Term
x) (Term -> Arg Term
forall e. e -> Arg e
argN Term
r)))
                    (Term -> Term -> Term)
-> ([Either (Arity, Bool) Term] -> Term)
-> [Either (Arity, Bool) Term]
-> Term
-> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Either (Arity, Bool) Term -> Term -> Term)
-> Term -> [Either (Arity, Bool) Term] -> Term
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
                      (\Either (Arity, Bool) Term
x Term
r -> IntervalView -> Term
unview (Arg Term -> Arg Term -> IntervalView
IMin (Term -> Arg Term
forall e. e -> Arg e
argN (((Arity, Bool) -> Term)
-> (Term -> Term) -> Either (Arity, Bool) Term -> Term
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Arity, Bool) -> Term
fm Term -> Term
ffr Either (Arity, Bool) Term
x)) (Term -> Arg Term
forall e. e -> Arg e
argN Term
r)))
                      (IntervalView -> Term
unview IntervalView
IOne)
                )
                (IntervalView -> Term
unview IntervalView
IZero)
                [[Either (Arity, Bool) Term]]
us
      --   traceSLn "cube.forall" 20 (unlines [show v, show us', show us, show r]) $
      Maybe Term -> m (Maybe Term)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Term -> m (Maybe Term)) -> Maybe Term -> m (Maybe Term)
forall a b. (a -> b) -> a -> b
$ case [(Map Arity Bool, [Term])]
us' of
        [(Map Arity Bool
m, [Term
_])] | Map Arity Bool -> Bool
forall k a. Map k a -> Bool
Map.null Map Arity Bool
m -> Maybe Term
forall a. Maybe a
Nothing
        [(Map Arity Bool, [Term])]
v -> Maybe Term
r

decomposeInterval :: HasBuiltins m => Term -> m [(Map Int Bool,[Term])]
decomposeInterval :: Term -> m [(Map Arity Bool, [Term])]
decomposeInterval Term
t = do
  [(Map Arity (Set Bool), [Term])]
xs <- Term -> m [(Map Arity (Set Bool), [Term])]
forall (m :: * -> *).
HasBuiltins m =>
Term -> m [(Map Arity (Set Bool), [Term])]
decomposeInterval' Term
t
  let isConsistent :: Map k (Set a) -> Bool
isConsistent Map k (Set a)
xs = (Set a -> Bool) -> [Set a] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\ Set a
xs -> Set a -> Arity
forall a. Set a -> Arity
Set.size Set a
xs Arity -> Arity -> Bool
forall a. Eq a => a -> a -> Bool
== Arity
1) ([Set a] -> Bool)
-> (Map k (Set a) -> [Set a]) -> Map k (Set a) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map k (Set a) -> [Set a]
forall k a. Map k a -> [a]
Map.elems (Map k (Set a) -> Bool) -> Map k (Set a) -> Bool
forall a b. (a -> b) -> a -> b
$ Map k (Set a)
xs  -- optimize by not doing generate + filter
  [(Map Arity Bool, [Term])] -> m [(Map Arity Bool, [Term])]
forall (m :: * -> *) a. Monad m => a -> m a
return [ ((Set Bool -> Bool) -> Map Arity (Set Bool) -> Map Arity Bool
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map ([Bool] -> Bool
forall a. [a] -> a
head ([Bool] -> Bool) -> (Set Bool -> [Bool]) -> Set Bool -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set Bool -> [Bool]
forall a. Set a -> [a]
Set.toList) Map Arity (Set Bool)
bsm,[Term]
ts)
            | (Map Arity (Set Bool)
bsm,[Term]
ts) <- [(Map Arity (Set Bool), [Term])]
xs
            , Map Arity (Set Bool) -> Bool
forall k a. Map k (Set a) -> Bool
isConsistent Map Arity (Set Bool)
bsm
            ]

decomposeInterval' :: HasBuiltins m => Term -> m [(Map Int (Set Bool),[Term])]
decomposeInterval' :: Term -> m [(Map Arity (Set Bool), [Term])]
decomposeInterval' Term
t = do
     Term -> IntervalView
view   <- m (Term -> IntervalView)
forall (m :: * -> *). HasBuiltins m => m (Term -> IntervalView)
intervalView'
     IntervalView -> Term
unview <- m (IntervalView -> Term)
forall (m :: * -> *). HasBuiltins m => m (IntervalView -> Term)
intervalUnview'
     let f :: IntervalView -> [[Either (Int,Bool) Term]]
         -- TODO handle primIMinDep
         -- TODO? handle forall
         f :: IntervalView -> [[Either (Arity, Bool) Term]]
f IntervalView
IZero = [[Either (Arity, Bool) Term]]
forall (m :: * -> *) a. MonadPlus m => m a
mzero
         f IntervalView
IOne  = [Either (Arity, Bool) Term] -> [[Either (Arity, Bool) Term]]
forall (m :: * -> *) a. Monad m => a -> m a
return []
         f (IMin Arg Term
x Arg Term
y) = do [Either (Arity, Bool) Term]
xs <- (IntervalView -> [[Either (Arity, Bool) Term]]
f (IntervalView -> [[Either (Arity, Bool) Term]])
-> (Arg Term -> IntervalView)
-> Arg Term
-> [[Either (Arity, Bool) Term]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term -> IntervalView
view (Term -> IntervalView)
-> (Arg Term -> Term) -> Arg Term -> IntervalView
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Arg Term -> Term
forall e. Arg e -> e
unArg) Arg Term
x; [Either (Arity, Bool) Term]
ys <- (IntervalView -> [[Either (Arity, Bool) Term]]
f (IntervalView -> [[Either (Arity, Bool) Term]])
-> (Arg Term -> IntervalView)
-> Arg Term
-> [[Either (Arity, Bool) Term]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term -> IntervalView
view (Term -> IntervalView)
-> (Arg Term -> Term) -> Arg Term -> IntervalView
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Arg Term -> Term
forall e. Arg e -> e
unArg) Arg Term
y; [Either (Arity, Bool) Term] -> [[Either (Arity, Bool) Term]]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Either (Arity, Bool) Term]
xs [Either (Arity, Bool) Term]
-> [Either (Arity, Bool) Term] -> [Either (Arity, Bool) Term]
forall a. [a] -> [a] -> [a]
++ [Either (Arity, Bool) Term]
ys)
         f (IMax Arg Term
x Arg Term
y) = [[[Either (Arity, Bool) Term]]] -> [[Either (Arity, Bool) Term]]
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum ([[[Either (Arity, Bool) Term]]] -> [[Either (Arity, Bool) Term]])
-> [[[Either (Arity, Bool) Term]]] -> [[Either (Arity, Bool) Term]]
forall a b. (a -> b) -> a -> b
$ (Arg Term -> [[Either (Arity, Bool) Term]])
-> [Arg Term] -> [[[Either (Arity, Bool) Term]]]
forall a b. (a -> b) -> [a] -> [b]
map (IntervalView -> [[Either (Arity, Bool) Term]]
f (IntervalView -> [[Either (Arity, Bool) Term]])
-> (Arg Term -> IntervalView)
-> Arg Term
-> [[Either (Arity, Bool) Term]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term -> IntervalView
view (Term -> IntervalView)
-> (Arg Term -> Term) -> Arg Term -> IntervalView
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Arg Term -> Term
forall e. Arg e -> e
unArg) [Arg Term
x,Arg Term
y]
         f (INeg Arg Term
x)   = (Either (Arity, Bool) Term -> Either (Arity, Bool) Term)
-> [Either (Arity, Bool) Term] -> [Either (Arity, Bool) Term]
forall a b. (a -> b) -> [a] -> [b]
map (((Arity, Bool) -> Either (Arity, Bool) Term)
-> (Term -> Either (Arity, Bool) Term)
-> Either (Arity, Bool) Term
-> Either (Arity, Bool) Term
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\ (Arity
x,Bool
y) -> (Arity, Bool) -> Either (Arity, Bool) Term
forall a b. a -> Either a b
Left (Arity
x,Bool -> Bool
not Bool
y)) (Term -> Either (Arity, Bool) Term
forall a b. b -> Either a b
Right (Term -> Either (Arity, Bool) Term)
-> (Term -> Term) -> Term -> Either (Arity, Bool) Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntervalView -> Term
unview (IntervalView -> Term) -> (Term -> IntervalView) -> Term -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Arg Term -> IntervalView
INeg (Arg Term -> IntervalView)
-> (Term -> Arg Term) -> Term -> IntervalView
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term -> Arg Term
forall e. e -> Arg e
argN)) ([Either (Arity, Bool) Term] -> [Either (Arity, Bool) Term])
-> [[Either (Arity, Bool) Term]] -> [[Either (Arity, Bool) Term]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (IntervalView -> [[Either (Arity, Bool) Term]]
f (IntervalView -> [[Either (Arity, Bool) Term]])
-> (Arg Term -> IntervalView)
-> Arg Term
-> [[Either (Arity, Bool) Term]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term -> IntervalView
view (Term -> IntervalView)
-> (Arg Term -> Term) -> Arg Term -> IntervalView
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Arg Term -> Term
forall e. Arg e -> e
unArg) Arg Term
x
         f (OTerm (Var Arity
i [])) = [Either (Arity, Bool) Term] -> [[Either (Arity, Bool) Term]]
forall (m :: * -> *) a. Monad m => a -> m a
return [(Arity, Bool) -> Either (Arity, Bool) Term
forall a b. a -> Either a b
Left (Arity
i,Bool
True)]
         f (OTerm Term
t)          = [Either (Arity, Bool) Term] -> [[Either (Arity, Bool) Term]]
forall (m :: * -> *) a. Monad m => a -> m a
return [Term -> Either (Arity, Bool) Term
forall a b. b -> Either a b
Right Term
t]
         v :: IntervalView
v = Term -> IntervalView
view Term
t
     [(Map Arity (Set Bool), [Term])]
-> m [(Map Arity (Set Bool), [Term])]
forall (m :: * -> *) a. Monad m => a -> m a
return [ (Map Arity (Set Bool)
bsm,[Term]
ts)
            | [Either (Arity, Bool) Term]
xs <- IntervalView -> [[Either (Arity, Bool) Term]]
f IntervalView
v
            , let ([(Arity, Bool)]
bs,[Term]
ts) = [Either (Arity, Bool) Term] -> ([(Arity, Bool)], [Term])
forall a b. [Either a b] -> ([a], [b])
partitionEithers [Either (Arity, Bool) Term]
xs
            , let bsm :: Map Arity (Set Bool)
bsm     = ((Set Bool -> Set Bool -> Set Bool)
-> [(Arity, Set Bool)] -> Map Arity (Set Bool)
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith Set Bool -> Set Bool -> Set Bool
forall a. Ord a => Set a -> Set a -> Set a
Set.union ([(Arity, Set Bool)] -> Map Arity (Set Bool))
-> ([(Arity, Bool)] -> [(Arity, Set Bool)])
-> [(Arity, Bool)]
-> Map Arity (Set Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Arity, Bool) -> (Arity, Set Bool))
-> [(Arity, Bool)] -> [(Arity, Set Bool)]
forall a b. (a -> b) -> [a] -> [b]
map (Arity -> Arity
forall a. a -> a
id (Arity -> Arity)
-> (Bool -> Set Bool) -> (Arity, Bool) -> (Arity, Set Bool)
forall a c b d. (a -> c) -> (b -> d) -> (a, b) -> (c, d)
-*- Bool -> Set Bool
forall a. a -> Set a
Set.singleton)) [(Arity, Bool)]
bs
            ]


-- | Tries to @primTransp@ a whole telescope of arguments, following the rule for Σ types.
--   If a type in the telescope does not support transp, @transpTel@ throws it as an exception.
transpTel :: Abs Telescope -- Γ ⊢ i.Δ
          -> Term          -- Γ ⊢ φ : F  -- i.Δ const on φ
          -> Args          -- Γ ⊢ δ : Δ[0]
          -> ExceptT (Closure (Abs Type)) TCM Args      -- Γ ⊢ Δ[1]
transpTel :: Abs Telescope
-> Term
-> [Arg Term]
-> ExceptT (Closure (Abs Type)) (TCMT IO) [Arg Term]
transpTel Abs Telescope
delta Term
phi [Arg Term]
args = do
  Term
tTransp <- TCMT IO Term -> ExceptT (Closure (Abs Type)) (TCMT IO) Term
forall (tcm :: * -> *) a. MonadTCM tcm => TCM a -> tcm a
liftTCM TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primTrans
  Term
imin <- TCMT IO Term -> ExceptT (Closure (Abs Type)) (TCMT IO) Term
forall (tcm :: * -> *) a. MonadTCM tcm => TCM a -> tcm a
liftTCM TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primIMin
  Term
imax <- TCMT IO Term -> ExceptT (Closure (Abs Type)) (TCMT IO) Term
forall (tcm :: * -> *) a. MonadTCM tcm => TCM a -> tcm a
liftTCM TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primIMax
  Term
ineg <- TCMT IO Term -> ExceptT (Closure (Abs Type)) (TCMT IO) Term
forall (tcm :: * -> *) a. MonadTCM tcm => TCM a -> tcm a
liftTCM TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primINeg
  let
    noTranspError :: a -> t m b
noTranspError a
t = m b -> t m b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m b -> t m b) -> (Closure a -> m b) -> Closure a -> t m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Closure a -> m b
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Closure a -> t m b) -> t m (Closure a) -> t m b
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< TCM (Closure a) -> t m (Closure a)
forall (tcm :: * -> *) a. MonadTCM tcm => TCM a -> tcm a
liftTCM (a -> TCM (Closure a)
forall (m :: * -> *) a.
(MonadTCEnv m, ReadTCState m) =>
a -> m (Closure a)
buildClosure a
t)
    bapp :: (Applicative m, Subst a) => m (Abs a) -> m (SubstArg a) -> m a
    bapp :: m (Abs a) -> m (SubstArg a) -> m a
bapp m (Abs a)
t m (SubstArg a)
u = Abs a -> SubstArg a -> a
forall a. Subst a => Abs a -> SubstArg a -> a
lazyAbsApp (Abs a -> SubstArg a -> a) -> m (Abs a) -> m (SubstArg a -> a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (Abs a)
t m (SubstArg a -> a) -> m (SubstArg a) -> m a
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m (SubstArg a)
u
    gTransp :: Maybe (NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term)
-> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) (Abs Type)
-> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term
-> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term
-> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term
gTransp (Just NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term
l) NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) (Abs Type)
t NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term
phi NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term
a = Term -> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
tTransp NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term
-> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term
-> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<#> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term
l NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term
-> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term
-> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> (ArgInfo -> Abs Term -> Term
Lam ArgInfo
defaultArgInfo (Abs Term -> Term) -> (Abs Type -> Abs Term) -> Abs Type -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Type -> Term) -> Abs Type -> Abs Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Type -> Term
forall t a. Type'' t a -> a
unEl (Abs Type -> Term)
-> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) (Abs Type)
-> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) (Abs Type)
t) NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term
-> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term
-> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term
phi NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term
-> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term
-> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term
a
    gTransp Maybe (NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term)
Nothing  NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) (Abs Type)
t NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term
phi NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term
a = do
      -- Γ ⊢ i.Ξ
      NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) (Abs Telescope)
xi <- (Abs Telescope
-> NamesT
     (ExceptT (Closure (Abs Type)) (TCMT IO))
     (NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) (Abs Telescope))
forall (m :: * -> *) a.
(MonadFail m, Subst a) =>
a -> NamesT m (NamesT m a)
open (Abs Telescope
 -> NamesT
      (ExceptT (Closure (Abs Type)) (TCMT IO))
      (NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) (Abs Telescope)))
-> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) (Abs Telescope)
-> NamesT
     (ExceptT (Closure (Abs Type)) (TCMT IO))
     (NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) (Abs Telescope))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) (Abs Telescope)
 -> NamesT
      (ExceptT (Closure (Abs Type)) (TCMT IO))
      (NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) (Abs Telescope)))
-> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) (Abs Telescope)
-> NamesT
     (ExceptT (Closure (Abs Type)) (TCMT IO))
     (NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) (Abs Telescope))
forall a b. (a -> b) -> a -> b
$ do
        String
-> (NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term
    -> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Telescope)
-> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) (Abs Telescope)
forall (m :: * -> *) b a.
(MonadFail m, Subst b, DeBruijn b, Subst a, Free a) =>
String -> (NamesT m b -> NamesT m a) -> NamesT m (Abs a)
bind String
"i" ((NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term
  -> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Telescope)
 -> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) (Abs Telescope))
-> (NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term
    -> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Telescope)
-> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) (Abs Telescope)
forall a b. (a -> b) -> a -> b
$ \ NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term
i -> do
          TelV Telescope
xi Type
_ <- (TCM (TelV Type)
-> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) (TelV Type)
forall (tcm :: * -> *) a. MonadTCM tcm => TCM a -> tcm a
liftTCM (TCM (TelV Type)
 -> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) (TelV Type))
-> (Type -> TCM (TelV Type))
-> Type
-> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) (TelV Type)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type -> TCM (TelV Type)
forall (m :: * -> *).
(MonadReduce m, MonadAddContext m) =>
Type -> m (TelV Type)
telView (Type
 -> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) (TelV Type))
-> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Type
-> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) (TelV Type)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Type
 -> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) (TelV Type))
-> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Type
-> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) (TelV Type)
forall a b. (a -> b) -> a -> b
$ NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) (Abs Type)
t NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) (Abs Type)
-> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) (SubstArg Type)
-> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Type
forall (m :: * -> *) a.
(Applicative m, Subst a) =>
m (Abs a) -> m (SubstArg a) -> m a
`bapp` NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term
NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) (SubstArg Type)
i
          Telescope
-> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Telescope
forall (m :: * -> *) a. Monad m => a -> m a
return Telescope
xi
      [Arg String]
argnames <- do
        Telescope -> [Arg String]
teleArgNames (Telescope -> [Arg String])
-> (Abs Telescope -> Telescope) -> Abs Telescope -> [Arg String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Abs Telescope -> Telescope
forall a. Abs a -> a
unAbs (Abs Telescope -> [Arg String])
-> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) (Abs Telescope)
-> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) [Arg String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) (Abs Telescope)
xi
      [Arg String]
-> (NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) [Arg Term]
    -> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term)
-> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term
forall (m :: * -> *).
(Functor m, MonadFail m) =>
[Arg String]
-> (NamesT m [Arg Term] -> NamesT m Term) -> NamesT m Term
glamN [Arg String]
argnames ((NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) [Arg Term]
  -> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term)
 -> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term)
-> (NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) [Arg Term]
    -> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term)
-> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term
forall a b. (a -> b) -> a -> b
$ \ NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) [Arg Term]
xi_args -> do
        Abs Type
b' <- String
-> (NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term
    -> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Type)
-> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) (Abs Type)
forall (m :: * -> *) b a.
(MonadFail m, Subst b, DeBruijn b, Subst a, Free a) =>
String -> (NamesT m b -> NamesT m a) -> NamesT m (Abs a)
bind String
"i" ((NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term
  -> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Type)
 -> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) (Abs Type))
-> (NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term
    -> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Type)
-> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) (Abs Type)
forall a b. (a -> b) -> a -> b
$ \ NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term
i -> do
          Type
ti <- NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) (Abs Type)
t NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) (Abs Type)
-> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) (SubstArg Type)
-> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Type
forall (m :: * -> *) a.
(Applicative m, Subst a) =>
m (Abs a) -> m (SubstArg a) -> m a
`bapp` NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term
NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) (SubstArg Type)
i
          Abs Telescope
xin <- String
-> (NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term
    -> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Telescope)
-> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) (Abs Telescope)
forall (m :: * -> *) b a.
(MonadFail m, Subst b, DeBruijn b, Subst a, Free a) =>
String -> (NamesT m b -> NamesT m a) -> NamesT m (Abs a)
bind String
"i" ((NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term
  -> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Telescope)
 -> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) (Abs Telescope))
-> (NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term
    -> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Telescope)
-> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) (Abs Telescope)
forall a b. (a -> b) -> a -> b
$ \ NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term
i -> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) (Abs Telescope)
xi NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) (Abs Telescope)
-> NamesT
     (ExceptT (Closure (Abs Type)) (TCMT IO)) (SubstArg Telescope)
-> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Telescope
forall (m :: * -> *) a.
(Applicative m, Subst a) =>
m (Abs a) -> m (SubstArg a) -> m a
`bapp` (Term -> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
ineg NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term
-> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term
-> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term
i)
          [Arg Term]
xi_args <- NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) [Arg Term]
xi_args
          Term
ni <- Term -> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
ineg NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term
-> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term
-> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term
i
          Term
phi <- NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term
phi
          ExceptT (Closure (Abs Type)) (TCMT IO) Type
-> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Type
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExceptT (Closure (Abs Type)) (TCMT IO) Type
 -> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Type)
-> ExceptT (Closure (Abs Type)) (TCMT IO) Type
-> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Type
forall a b. (a -> b) -> a -> b
$ Type -> [Arg Term] -> ExceptT (Closure (Abs Type)) (TCMT IO) Type
forall a (m :: * -> *).
(PiApplyM a, MonadReduce m, HasBuiltins m) =>
Type -> a -> m Type
piApplyM Type
ti ([Arg Term] -> ExceptT (Closure (Abs Type)) (TCMT IO) Type)
-> ExceptT (Closure (Abs Type)) (TCMT IO) [Arg Term]
-> ExceptT (Closure (Abs Type)) (TCMT IO) Type
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Abs Telescope
-> Term
-> [Arg Term]
-> Term
-> ExceptT (Closure (Abs Type)) (TCMT IO) [Arg Term]
trFillTel Abs Telescope
xin Term
phi [Arg Term]
xi_args Term
ni
        Term
axi <- do
          Term
a <- NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term
a
          Abs Telescope
xif <- String
-> (NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term
    -> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Telescope)
-> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) (Abs Telescope)
forall (m :: * -> *) b a.
(MonadFail m, Subst b, DeBruijn b, Subst a, Free a) =>
String -> (NamesT m b -> NamesT m a) -> NamesT m (Abs a)
bind String
"i" ((NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term
  -> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Telescope)
 -> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) (Abs Telescope))
-> (NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term
    -> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Telescope)
-> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) (Abs Telescope)
forall a b. (a -> b) -> a -> b
$ \ NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term
i -> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) (Abs Telescope)
xi NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) (Abs Telescope)
-> NamesT
     (ExceptT (Closure (Abs Type)) (TCMT IO)) (SubstArg Telescope)
-> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Telescope
forall (m :: * -> *) a.
(Applicative m, Subst a) =>
m (Abs a) -> m (SubstArg a) -> m a
`bapp` (Term -> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
ineg NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term
-> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term
-> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term
i)
          Term
phi <- NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term
phi
          [Arg Term]
xi_args <- NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) [Arg Term]
xi_args
          ExceptT (Closure (Abs Type)) (TCMT IO) Term
-> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExceptT (Closure (Abs Type)) (TCMT IO) Term
 -> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term)
-> ExceptT (Closure (Abs Type)) (TCMT IO) Term
-> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term
forall a b. (a -> b) -> a -> b
$ Term -> [Arg Term] -> Term
forall t. Apply t => t -> [Arg Term] -> t
apply Term
a ([Arg Term] -> Term)
-> ExceptT (Closure (Abs Type)) (TCMT IO) [Arg Term]
-> ExceptT (Closure (Abs Type)) (TCMT IO) Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Abs Telescope
-> Term
-> [Arg Term]
-> ExceptT (Closure (Abs Type)) (TCMT IO) [Arg Term]
transpTel Abs Telescope
xif Term
phi [Arg Term]
xi_args
        Sort' Term
s <- Sort' Term
-> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) (Sort' Term)
forall a (m :: * -> *). (Reduce a, MonadReduce m) => a -> m a
reduce (Sort' Term
 -> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) (Sort' Term))
-> Sort' Term
-> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) (Sort' Term)
forall a b. (a -> b) -> a -> b
$ Type -> Sort' Term
forall a. LensSort a => a -> Sort' Term
getSort (Abs Type -> Type
forall a. Subst a => Abs a -> a
absBody Abs Type
b')
        case Sort' Term
s of
          Type Level' Term
l -> do
            NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term
l <- Term
-> NamesT
     (ExceptT (Closure (Abs Type)) (TCMT IO))
     (NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term)
forall (m :: * -> *) a.
(MonadFail m, Subst a) =>
a -> NamesT m (NamesT m a)
open (Term
 -> NamesT
      (ExceptT (Closure (Abs Type)) (TCMT IO))
      (NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term))
-> Term
-> NamesT
     (ExceptT (Closure (Abs Type)) (TCMT IO))
     (NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term)
forall a b. (a -> b) -> a -> b
$ Term -> Term
lam_i (Level' Term -> Term
Level Level' Term
l)
            NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) (Abs Type)
b' <- Abs Type
-> NamesT
     (ExceptT (Closure (Abs Type)) (TCMT IO))
     (NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) (Abs Type))
forall (m :: * -> *) a.
(MonadFail m, Subst a) =>
a -> NamesT m (NamesT m a)
open Abs Type
b'
            NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term
axi <- Term
-> NamesT
     (ExceptT (Closure (Abs Type)) (TCMT IO))
     (NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term)
forall (m :: * -> *) a.
(MonadFail m, Subst a) =>
a -> NamesT m (NamesT m a)
open Term
axi
            Maybe (NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term)
-> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) (Abs Type)
-> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term
-> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term
-> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term
gTransp (NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term
-> Maybe (NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term)
forall a. a -> Maybe a
Just NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term
l) NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) (Abs Type)
b' NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term
phi NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term
axi
          Inf IsFibrant
_ Integer
n  ->
            if Arity
0 Arity -> Type -> Bool
forall a. Free a => Arity -> a -> Bool
`freeIn` (Arity -> Abs Type -> Abs Type
forall a. Subst a => Arity -> a -> a
raise Arity
1 Abs Type
b' Abs Type -> SubstArg Type -> Type
forall a. Subst a => Abs a -> SubstArg a -> a
`lazyAbsApp` Arity -> Term
var Arity
0) then Abs Type -> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a b.
(MonadTrans t, MonadError (Closure a) m, MonadTCM (t m)) =>
a -> t m b
noTranspError Abs Type
b' else Term -> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term
forall (m :: * -> *) a. Monad m => a -> m a
return Term
axi
          SSet Level' Term
_  ->
            if Arity
0 Arity -> Type -> Bool
forall a. Free a => Arity -> a -> Bool
`freeIn` (Arity -> Abs Type -> Abs Type
forall a. Subst a => Arity -> a -> a
raise Arity
1 Abs Type
b' Abs Type -> SubstArg Type -> Type
forall a. Subst a => Abs a -> SubstArg a -> a
`lazyAbsApp` Arity -> Term
var Arity
0) then Abs Type -> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a b.
(MonadTrans t, MonadError (Closure a) m, MonadTCM (t m)) =>
a -> t m b
noTranspError Abs Type
b' else Term -> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term
forall (m :: * -> *) a. Monad m => a -> m a
return Term
axi
          Sort' Term
_ -> Abs Type -> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a b.
(MonadTrans t, MonadError (Closure a) m, MonadTCM (t m)) =>
a -> t m b
noTranspError Abs Type
b'
    lam_i :: Term -> Term
lam_i = ArgInfo -> Abs Term -> Term
Lam ArgInfo
defaultArgInfo (Abs Term -> Term) -> (Term -> Abs Term) -> Term -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Term -> Abs Term
forall a. String -> a -> Abs a
Abs String
"i"
    go :: Telescope -> Term -> Args -> ExceptT (Closure (Abs Type)) TCM Args
    go :: Telescope
-> Term
-> [Arg Term]
-> ExceptT (Closure (Abs Type)) (TCMT IO) [Arg Term]
go Telescope
EmptyTel            Term
_   []       = [Arg Term] -> ExceptT (Closure (Abs Type)) (TCMT IO) [Arg Term]
forall (m :: * -> *) a. Monad m => a -> m a
return []
    go (ExtendTel Dom Type
t Abs Telescope
delta) Term
phi (Arg Term
a:[Arg Term]
args) = do
      -- Γ,i ⊢ t
      -- Γ,i ⊢ (x : t). delta
      -- Γ ⊢ a : t[0]
      Sort' Term
s <- Sort' Term -> ExceptT (Closure (Abs Type)) (TCMT IO) (Sort' Term)
forall a (m :: * -> *). (Reduce a, MonadReduce m) => a -> m a
reduce (Sort' Term -> ExceptT (Closure (Abs Type)) (TCMT IO) (Sort' Term))
-> Sort' Term
-> ExceptT (Closure (Abs Type)) (TCMT IO) (Sort' Term)
forall a b. (a -> b) -> a -> b
$ Dom Type -> Sort' Term
forall a. LensSort a => a -> Sort' Term
getSort Dom Type
t
      -- Γ ⊢ b : t[1], Γ,i ⊢ b : t[i]
      (Term
b,Term
bf) <- Names
-> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) (Term, Term)
-> ExceptT (Closure (Abs Type)) (TCMT IO) (Term, Term)
forall (m :: * -> *) a. Names -> NamesT m a -> m a
runNamesT [] (NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) (Term, Term)
 -> ExceptT (Closure (Abs Type)) (TCMT IO) (Term, Term))
-> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) (Term, Term)
-> ExceptT (Closure (Abs Type)) (TCMT IO) (Term, Term)
forall a b. (a -> b) -> a -> b
$ do
        Maybe (NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term)
l <- case Sort' Term
s of
               SSet Level' Term
_ -> Maybe (NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term)
-> NamesT
     (ExceptT (Closure (Abs Type)) (TCMT IO))
     (Maybe (NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term)
forall a. Maybe a
Nothing
               Inf IsFibrant
_ Integer
n -> Maybe (NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term)
-> NamesT
     (ExceptT (Closure (Abs Type)) (TCMT IO))
     (Maybe (NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term)
forall a. Maybe a
Nothing
               Type Level' Term
l -> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term
-> Maybe (NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term)
forall a. a -> Maybe a
Just (NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term
 -> Maybe (NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term))
-> NamesT
     (ExceptT (Closure (Abs Type)) (TCMT IO))
     (NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term)
-> NamesT
     (ExceptT (Closure (Abs Type)) (TCMT IO))
     (Maybe (NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term
-> NamesT
     (ExceptT (Closure (Abs Type)) (TCMT IO))
     (NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term)
forall (m :: * -> *) a.
(MonadFail m, Subst a) =>
a -> NamesT m (NamesT m a)
open (Term -> Term
lam_i (Level' Term -> Term
Level Level' Term
l))
               Sort' Term
_ -> Abs Type
-> NamesT
     (ExceptT (Closure (Abs Type)) (TCMT IO))
     (Maybe (NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a b.
(MonadTrans t, MonadError (Closure a) m, MonadTCM (t m)) =>
a -> t m b
noTranspError (String -> Type -> Abs Type
forall a. String -> a -> Abs a
Abs String
"i" (Dom Type -> Type
forall t e. Dom' t e -> e
unDom Dom Type
t))
        NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) (Abs Type)
t <- Abs Type
-> NamesT
     (ExceptT (Closure (Abs Type)) (TCMT IO))
     (NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) (Abs Type))
forall (m :: * -> *) a.
(MonadFail m, Subst a) =>
a -> NamesT m (NamesT m a)
open (Abs Type
 -> NamesT
      (ExceptT (Closure (Abs Type)) (TCMT IO))
      (NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) (Abs Type)))
-> Abs Type
-> NamesT
     (ExceptT (Closure (Abs Type)) (TCMT IO))
     (NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) (Abs Type))
forall a b. (a -> b) -> a -> b
$ String -> Type -> Abs Type
forall a. String -> a -> Abs a
Abs String
"i" (Dom Type -> Type
forall t e. Dom' t e -> e
unDom Dom Type
t)
        [NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term
phi,NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term
a] <- (Term
 -> NamesT
      (ExceptT (Closure (Abs Type)) (TCMT IO))
      (NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term))
-> [Term]
-> NamesT
     (ExceptT (Closure (Abs Type)) (TCMT IO))
     [NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Term
-> NamesT
     (ExceptT (Closure (Abs Type)) (TCMT IO))
     (NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term)
forall (m :: * -> *) a.
(MonadFail m, Subst a) =>
a -> NamesT m (NamesT m a)
open [Term
phi, Arg Term -> Term
forall e. Arg e -> e
unArg Arg Term
a]
        Term
b <- Maybe (NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term)
-> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) (Abs Type)
-> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term
-> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term
-> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term
gTransp Maybe (NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term)
l NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) (Abs Type)
t NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term
phi NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term
a
        Abs Term
bf <- String
-> (NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term
    -> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term)
-> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) (Abs Term)
forall (m :: * -> *) b a.
(MonadFail m, Subst b, DeBruijn b, Subst a, Free a) =>
String -> (NamesT m b -> NamesT m a) -> NamesT m (Abs a)
bind String
"i" ((NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term
  -> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term)
 -> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) (Abs Term))
-> (NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term
    -> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term)
-> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) (Abs Term)
forall a b. (a -> b) -> a -> b
$ \ NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term
i -> do
                            Maybe (NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term)
-> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) (Abs Type)
-> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term
-> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term
-> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term
gTransp (((NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term
 -> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term)
-> Maybe (NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term)
-> Maybe (NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term)
l) ((NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term
  -> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term)
 -> Maybe (NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term))
-> (NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term
    -> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term)
-> Maybe (NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term)
forall a b. (a -> b) -> a -> b
$ \ NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term
l -> String
-> (NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term
    -> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term)
-> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term
forall (m :: * -> *).
MonadFail m =>
String -> (NamesT m Term -> NamesT m Term) -> NamesT m Term
lam String
"j" ((NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term
  -> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term)
 -> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term)
-> (NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term
    -> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term)
-> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term
forall a b. (a -> b) -> a -> b
$ \ NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term
j -> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term
l NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term
-> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term
-> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> (Term -> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
imin NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term
-> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term
-> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term
i NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term
-> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term
-> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term
j))
                                    (String
-> (NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term
    -> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Type)
-> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) (Abs Type)
forall (m :: * -> *) b a.
(MonadFail m, Subst b, DeBruijn b, Subst a, Free a) =>
String -> (NamesT m b -> NamesT m a) -> NamesT m (Abs a)
bind String
"j" ((NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term
  -> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Type)
 -> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) (Abs Type))
-> (NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term
    -> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Type)
-> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) (Abs Type)
forall a b. (a -> b) -> a -> b
$ \ NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term
j -> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) (Abs Type)
t NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) (Abs Type)
-> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) (SubstArg Type)
-> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Type
forall (m :: * -> *) a.
(Applicative m, Subst a) =>
m (Abs a) -> m (SubstArg a) -> m a
`bapp` (Term -> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
imin NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term
-> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term
-> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term
i NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term
-> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term
-> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term
j))
                                    (Term -> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
imax NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term
-> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term
-> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> (Term -> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
ineg NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term
-> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term
-> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term
i) NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term
-> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term
-> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term
forall (m :: * -> *). Applicative m => m Term -> m Term -> m Term
<@> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term
phi)
                                    NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) Term
a
        (Term, Term)
-> NamesT (ExceptT (Closure (Abs Type)) (TCMT IO)) (Term, Term)
forall (m :: * -> *) a. Monad m => a -> m a
return (Term
b, Abs Term -> Term
forall a. Subst a => Abs a -> a
absBody Abs Term
bf)
      (:) (Term
b Term -> Arg Term -> Arg Term
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Arg Term
a) ([Arg Term] -> [Arg Term])
-> ExceptT (Closure (Abs Type)) (TCMT IO) [Arg Term]
-> ExceptT (Closure (Abs Type)) (TCMT IO) [Arg Term]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Telescope
-> Term
-> [Arg Term]
-> ExceptT (Closure (Abs Type)) (TCMT IO) [Arg Term]
go (Abs Telescope -> SubstArg Telescope -> Telescope
forall a. Subst a => Abs a -> SubstArg a -> a
lazyAbsApp Abs Telescope
delta Term
SubstArg Telescope
bf) Term
phi [Arg Term]
args
    go (ExtendTel Dom Type
t Abs Telescope
delta) Term
phi []    = ExceptT (Closure (Abs Type)) (TCMT IO) [Arg Term]
forall a. HasCallStack => a
__IMPOSSIBLE__
    go Telescope
EmptyTel            Term
_   (Arg Term
_:[Arg Term]
_) = ExceptT (Closure (Abs Type)) (TCMT IO) [Arg Term]
forall a. HasCallStack => a
__IMPOSSIBLE__
  Telescope
-> Term
-> [Arg Term]
-> ExceptT (Closure (Abs Type)) (TCMT IO) [Arg Term]
go (Abs Telescope -> Telescope
forall a. Subst a => Abs a -> a
absBody Abs Telescope
delta) Term
phi [Arg Term]
args

-- | Like @transpTel@ but performing a transpFill.
trFillTel :: Abs Telescope -- Γ ⊢ i.Δ
          -> Term
          -> Args          -- Γ ⊢ δ : Δ[0]
          -> Term          -- Γ ⊢ r : I
          -> ExceptT (Closure (Abs Type)) TCM Args      -- Γ ⊢ Δ[r]
trFillTel :: Abs Telescope
-> Term
-> [Arg Term]
-> Term
-> ExceptT (Closure (Abs Type)) (TCMT IO) [Arg Term]
trFillTel Abs Telescope
delta Term
phi [Arg Term]
args Term
r = do
  Term
imin <- TCMT IO Term -> ExceptT (Closure (Abs Type)) (TCMT IO) Term
forall (tcm :: * -> *) a. MonadTCM tcm => TCM a -> tcm a
liftTCM TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primIMin
  Term
imax <- TCMT IO Term -> ExceptT (Closure (Abs Type)) (TCMT IO) Term
forall (tcm :: * -> *) a. MonadTCM tcm => TCM a -> tcm a
liftTCM TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primIMax
  Term
ineg <- TCMT IO Term -> ExceptT (Closure (Abs Type)) (TCMT IO) Term
forall (tcm :: * -> *) a. MonadTCM tcm => TCM a -> tcm a
liftTCM TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primINeg
  Abs Telescope
-> Term
-> [Arg Term]
-> ExceptT (Closure (Abs Type)) (TCMT IO) [Arg Term]
transpTel (String -> Telescope -> Abs Telescope
forall a. String -> a -> Abs a
Abs String
"j" (Telescope -> Abs Telescope) -> Telescope -> Abs Telescope
forall a b. (a -> b) -> a -> b
$ Arity -> Abs Telescope -> Abs Telescope
forall a. Subst a => Arity -> a -> a
raise Arity
1 Abs Telescope
delta Abs Telescope -> SubstArg Telescope -> Telescope
forall a. Subst a => Abs a -> SubstArg a -> a
`lazyAbsApp` (Term
imin Term -> [Arg Term] -> Term
forall t. Apply t => t -> [Arg Term] -> t
`apply` ((Term -> Arg Term) -> [Term] -> [Arg Term]
forall a b. (a -> b) -> [a] -> [b]
map Term -> Arg Term
forall e. e -> Arg e
argN [Arity -> Term
var Arity
0, Arity -> Term -> Term
forall a. Subst a => Arity -> a -> a
raise Arity
1 Term
r])))
            (Term
imax Term -> [Arg Term] -> Term
forall t. Apply t => t -> [Arg Term] -> t
`apply` [Term -> Arg Term
forall e. e -> Arg e
argN (Term -> Arg Term) -> Term -> Arg Term
forall a b. (a -> b) -> a -> b
$ Term
ineg Term -> [Arg Term] -> Term
forall t. Apply t => t -> [Arg Term] -> t
`apply` [Term -> Arg Term
forall e. e -> Arg e
argN Term
r], Term -> Arg Term
forall e. e -> Arg e
argN Term
phi])
            [Arg Term]
args