{-# LANGUAGE NondecreasingIndentation #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE TypeFamilies #-}
module Agda.TypeChecking.Reduce where
import Prelude hiding (mapM)
import Control.Monad.Reader hiding (mapM)
import Data.List ((\\))
import Data.Maybe
import Data.Map (Map)
import Data.Traversable
import Data.HashMap.Strict (HashMap)
import Agda.Interaction.Options
import Agda.Syntax.Position
import Agda.Syntax.Common
import Agda.Syntax.Internal
import Agda.Syntax.Internal.MetaVars
import Agda.Syntax.Scope.Base (Scope)
import Agda.Syntax.Literal
import {-# SOURCE #-} Agda.TypeChecking.Irrelevance (workOnTypes, isPropM)
import {-# SOURCE #-} Agda.TypeChecking.Level (reallyUnLevelView)
import Agda.TypeChecking.Monad hiding ( enterClosure, constructorForm )
import qualified Agda.TypeChecking.Monad as TCM
import Agda.TypeChecking.Substitute
import Agda.TypeChecking.CompiledClause
import Agda.TypeChecking.EtaContract
import Agda.TypeChecking.Reduce.Monad
import {-# SOURCE #-} Agda.TypeChecking.CompiledClause.Match
import {-# SOURCE #-} Agda.TypeChecking.Patterns.Match
import {-# SOURCE #-} Agda.TypeChecking.Pretty
import {-# SOURCE #-} Agda.TypeChecking.Rewriting
import {-# SOURCE #-} Agda.TypeChecking.Reduce.Fast
import Agda.Utils.Functor
import Agda.Utils.Lens
import Agda.Utils.Maybe
import qualified Agda.Utils.Maybe.Strict as Strict
import Agda.Utils.Monad
import Agda.Utils.Size
import Agda.Utils.Tuple
import qualified Agda.Utils.SmallSet as SmallSet
import Agda.Utils.Impossible
instantiate :: (Instantiate a, MonadReduce m) => a -> m a
instantiate :: a -> m a
instantiate = ReduceM a -> m a
forall (m :: * -> *) a. MonadReduce m => ReduceM a -> m a
liftReduce (ReduceM a -> m a) -> (a -> ReduceM a) -> a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ReduceM a
forall t. Instantiate t => t -> ReduceM t
instantiate'
instantiateFull :: (InstantiateFull a, MonadReduce m) => a -> m a
instantiateFull :: a -> m a
instantiateFull = ReduceM a -> m a
forall (m :: * -> *) a. MonadReduce m => ReduceM a -> m a
liftReduce (ReduceM a -> m a) -> (a -> ReduceM a) -> a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ReduceM a
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull'
reduce :: (Reduce a, MonadReduce m) => a -> m a
reduce :: a -> m a
reduce = ReduceM a -> m a
forall (m :: * -> *) a. MonadReduce m => ReduceM a -> m a
liftReduce (ReduceM a -> m a) -> (a -> ReduceM a) -> a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ReduceM a
forall t. Reduce t => t -> ReduceM t
reduce'
reduceB :: (Reduce a, MonadReduce m) => a -> m (Blocked a)
reduceB :: a -> m (Blocked a)
reduceB = ReduceM (Blocked a) -> m (Blocked a)
forall (m :: * -> *) a. MonadReduce m => ReduceM a -> m a
liftReduce (ReduceM (Blocked a) -> m (Blocked a))
-> (a -> ReduceM (Blocked a)) -> a -> m (Blocked a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ReduceM (Blocked a)
forall t. Reduce t => t -> ReduceM (Blocked t)
reduceB'
normalise :: (Normalise a, MonadReduce m) => a -> m a
normalise :: a -> m a
normalise = ReduceM a -> m a
forall (m :: * -> *) a. MonadReduce m => ReduceM a -> m a
liftReduce (ReduceM a -> m a) -> (a -> ReduceM a) -> a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ReduceM a
forall t. Normalise t => t -> ReduceM t
normalise'
normaliseB :: (MonadReduce m, Reduce t, Normalise t) => t -> m (Blocked t)
normaliseB :: t -> m (Blocked t)
normaliseB = t -> m t
forall a (m :: * -> *). (Normalise a, MonadReduce m) => a -> m a
normalise (t -> m t) -> (t -> m (Blocked t)) -> t -> m (Blocked t)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> t -> m (Blocked t)
forall a (m :: * -> *).
(Reduce a, MonadReduce m) =>
a -> m (Blocked a)
reduceB
simplify :: (Simplify a, MonadReduce m) => a -> m a
simplify :: a -> m a
simplify = ReduceM a -> m a
forall (m :: * -> *) a. MonadReduce m => ReduceM a -> m a
liftReduce (ReduceM a -> m a) -> (a -> ReduceM a) -> a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ReduceM a
forall t. Simplify t => t -> ReduceM t
simplify'
isFullyInstantiatedMeta :: MetaId -> TCM Bool
isFullyInstantiatedMeta :: MetaId -> TCM Bool
isFullyInstantiatedMeta m :: MetaId
m = do
MetaVariable
mv <- MetaId -> TCMT IO MetaVariable
forall (m :: * -> *).
(MonadFail m, ReadTCState m) =>
MetaId -> m MetaVariable
lookupMeta MetaId
m
case MetaVariable -> MetaInstantiation
mvInstantiation MetaVariable
mv of
InstV _tel :: [Arg String]
_tel v :: Term
v -> Term -> Bool
forall a. TermLike a => a -> Bool
noMetas (Term -> Bool) -> TCMT IO Term -> TCM Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term -> TCMT IO Term
forall a (m :: * -> *).
(InstantiateFull a, MonadReduce m) =>
a -> m a
instantiateFull Term
v
_ -> Bool -> TCM Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
class Instantiate t where
instantiate' :: t -> ReduceM t
default instantiate' :: (t ~ f a, Traversable f, Instantiate a) => t -> ReduceM t
instantiate' = (a -> ReduceM a) -> f a -> ReduceM (f a)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> ReduceM a
forall t. Instantiate t => t -> ReduceM t
instantiate'
instance Instantiate t => Instantiate [t]
instance Instantiate t => Instantiate (Map k t)
instance Instantiate t => Instantiate (Maybe t)
instance Instantiate t => Instantiate (Strict.Maybe t)
instance Instantiate t => Instantiate (Abs t)
instance Instantiate t => Instantiate (Arg t)
instance Instantiate t => Instantiate (Elim' t)
instance Instantiate t => Instantiate (Tele t)
instance (Instantiate a, Instantiate b) => Instantiate (a,b) where
instantiate' :: (a, b) -> ReduceM (a, b)
instantiate' (x :: a
x,y :: b
y) = (,) (a -> b -> (a, b)) -> ReduceM a -> ReduceM (b -> (a, b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> ReduceM a
forall t. Instantiate t => t -> ReduceM t
instantiate' a
x ReduceM (b -> (a, b)) -> ReduceM b -> ReduceM (a, b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> b -> ReduceM b
forall t. Instantiate t => t -> ReduceM t
instantiate' b
y
instance (Instantiate a, Instantiate b,Instantiate c) => Instantiate (a,b,c) where
instantiate' :: (a, b, c) -> ReduceM (a, b, c)
instantiate' (x :: a
x,y :: b
y,z :: c
z) = (,,) (a -> b -> c -> (a, b, c))
-> ReduceM a -> ReduceM (b -> c -> (a, b, c))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> ReduceM a
forall t. Instantiate t => t -> ReduceM t
instantiate' a
x ReduceM (b -> c -> (a, b, c))
-> ReduceM b -> ReduceM (c -> (a, b, c))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> b -> ReduceM b
forall t. Instantiate t => t -> ReduceM t
instantiate' b
y ReduceM (c -> (a, b, c)) -> ReduceM c -> ReduceM (a, b, c)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> c -> ReduceM c
forall t. Instantiate t => t -> ReduceM t
instantiate' c
z
instance Instantiate Term where
instantiate' :: Term -> ReduceM Term
instantiate' t :: Term
t@(MetaV x :: MetaId
x es :: Elims
es) = do
Bool
blocking <- Lens' Bool TCState -> TCState -> Bool
forall o (m :: * -> *) i. MonadReader o m => Lens' i o -> m i
view Lens' Bool TCState
stInstantiateBlocking (TCState -> Bool) -> ReduceM TCState -> ReduceM Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReduceM TCState
forall (m :: * -> *). ReadTCState m => m TCState
getTCState
MetaVariable
mv <- MetaId -> ReduceM MetaVariable
forall (m :: * -> *).
(MonadFail m, ReadTCState m) =>
MetaId -> m MetaVariable
lookupMeta MetaId
x
MetaInstantiation
mi <- MetaVariable -> MetaInstantiation
mvInstantiation (MetaVariable -> MetaInstantiation)
-> ReduceM MetaVariable -> ReduceM MetaInstantiation
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MetaVariable -> ReduceM MetaVariable
forall (f :: * -> *) a. Applicative f => a -> f a
pure MetaVariable
mv
case MetaInstantiation
mi of
InstV tel :: [Arg String]
tel v :: Term
v -> Term -> ReduceM Term
forall t. Instantiate t => t -> ReduceM t
instantiate' Term
inst
where
(es1 :: Elims
es1, es2 :: Elims
es2) = Int -> Elims -> (Elims, Elims)
forall a. Int -> [a] -> ([a], [a])
splitAt ([Arg String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Arg String]
tel) Elims
es
vs1 :: [Term]
vs1 = [Term] -> [Term]
forall a. [a] -> [a]
reverse ([Term] -> [Term]) -> [Term] -> [Term]
forall a b. (a -> b) -> a -> b
$ (Arg Term -> Term) -> [Arg Term] -> [Term]
forall a b. (a -> b) -> [a] -> [b]
map Arg Term -> Term
forall e. Arg e -> e
unArg ([Arg Term] -> [Term]) -> [Arg Term] -> [Term]
forall a b. (a -> b) -> a -> b
$ [Arg Term] -> Maybe [Arg Term] -> [Arg Term]
forall a. a -> Maybe a -> a
fromMaybe [Arg Term]
forall a. HasCallStack => a
__IMPOSSIBLE__ (Maybe [Arg Term] -> [Arg Term]) -> Maybe [Arg Term] -> [Arg Term]
forall a b. (a -> b) -> a -> b
$ Elims -> Maybe [Arg Term]
forall a. [Elim' a] -> Maybe [Arg a]
allApplyElims Elims
es1
rho :: Substitution' Term
rho = [Term]
vs1 [Term] -> Substitution' Term -> Substitution' Term
forall a. DeBruijn a => [a] -> Substitution' a -> Substitution' a
++# Int -> Substitution' Term -> Substitution' Term
forall a. Int -> Substitution' a -> Substitution' a
wkS ([Term] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Term]
vs1) Substitution' Term
forall a. Substitution' a
idS
inst :: Term
inst = Substitution' Term -> Term -> Term
forall t a. Subst t a => Substitution' t -> a -> a
applySubst Substitution' Term
rho ((Arg String -> Term -> Term) -> Term -> [Arg String] -> Term
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Arg String -> Term -> Term
mkLam Term
v ([Arg String] -> Term) -> [Arg String] -> Term
forall a b. (a -> b) -> a -> b
$ Int -> [Arg String] -> [Arg String]
forall a. Int -> [a] -> [a]
drop (Elims -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Elims
es1) [Arg String]
tel) Term -> Elims -> Term
forall t. Apply t => t -> Elims -> t
`applyE` Elims
es2
_ | Just m' :: MetaId
m' <- MetaVariable -> Maybe MetaId
mvTwin MetaVariable
mv, Bool
blocking -> do
Term -> ReduceM Term
forall t. Instantiate t => t -> ReduceM t
instantiate' (MetaId -> Elims -> Term
MetaV MetaId
m' Elims
es)
Open -> Term -> ReduceM Term
forall (m :: * -> *) a. Monad m => a -> m a
return Term
t
OpenInstance -> Term -> ReduceM Term
forall (m :: * -> *) a. Monad m => a -> m a
return Term
t
BlockedConst u :: Term
u | Bool
blocking -> Term -> ReduceM Term
forall t. Instantiate t => t -> ReduceM t
instantiate' (Term -> ReduceM Term)
-> (BraveTerm -> Term) -> BraveTerm -> ReduceM Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BraveTerm -> Term
unBrave (BraveTerm -> ReduceM Term) -> BraveTerm -> ReduceM Term
forall a b. (a -> b) -> a -> b
$ Term -> BraveTerm
BraveTerm Term
u BraveTerm -> Elims -> BraveTerm
forall t. Apply t => t -> Elims -> t
`applyE` Elims
es
| Bool
otherwise -> Term -> ReduceM Term
forall (m :: * -> *) a. Monad m => a -> m a
return Term
t
PostponedTypeCheckingProblem _ _ -> Term -> ReduceM Term
forall (m :: * -> *) a. Monad m => a -> m a
return Term
t
instantiate' (Level l :: Level
l) = Level -> Term
levelTm (Level -> Term) -> ReduceM Level -> ReduceM Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Level -> ReduceM Level
forall t. Instantiate t => t -> ReduceM t
instantiate' Level
l
instantiate' (Sort s :: Sort
s) = Sort -> Term
Sort (Sort -> Term) -> ReduceM Sort -> ReduceM Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sort -> ReduceM Sort
forall t. Instantiate t => t -> ReduceM t
instantiate' Sort
s
instantiate' t :: Term
t = Term -> ReduceM Term
forall (m :: * -> *) a. Monad m => a -> m a
return Term
t
instance Instantiate t => Instantiate (Type' t) where
instantiate' :: Type' t -> ReduceM (Type' t)
instantiate' (El s :: Sort
s t :: t
t) = Sort -> t -> Type' t
forall t a. Sort' t -> a -> Type'' t a
El (Sort -> t -> Type' t) -> ReduceM Sort -> ReduceM (t -> Type' t)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sort -> ReduceM Sort
forall t. Instantiate t => t -> ReduceM t
instantiate' Sort
s ReduceM (t -> Type' t) -> ReduceM t -> ReduceM (Type' t)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> t -> ReduceM t
forall t. Instantiate t => t -> ReduceM t
instantiate' t
t
instance Instantiate Level where
instantiate' :: Level -> ReduceM Level
instantiate' (Max m :: Integer
m as :: [PlusLevel' Term]
as) = Integer -> [PlusLevel' Term] -> Level
levelMax Integer
m ([PlusLevel' Term] -> Level)
-> ReduceM [PlusLevel' Term] -> ReduceM Level
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [PlusLevel' Term] -> ReduceM [PlusLevel' Term]
forall t. Instantiate t => t -> ReduceM t
instantiate' [PlusLevel' Term]
as
instance Instantiate PlusLevel where
instantiate' :: PlusLevel' Term -> ReduceM (PlusLevel' Term)
instantiate' (Plus n :: Integer
n a :: LevelAtom' Term
a) = Integer -> LevelAtom' Term -> PlusLevel' Term
forall t. Integer -> LevelAtom' t -> PlusLevel' t
Plus Integer
n (LevelAtom' Term -> PlusLevel' Term)
-> ReduceM (LevelAtom' Term) -> ReduceM (PlusLevel' Term)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LevelAtom' Term -> ReduceM (LevelAtom' Term)
forall t. Instantiate t => t -> ReduceM t
instantiate' LevelAtom' Term
a
instance Instantiate LevelAtom where
instantiate' :: LevelAtom' Term -> ReduceM (LevelAtom' Term)
instantiate' l :: LevelAtom' Term
l = case LevelAtom' Term
l of
MetaLevel m :: MetaId
m vs :: Elims
vs -> do
Term
v <- Term -> ReduceM Term
forall t. Instantiate t => t -> ReduceM t
instantiate' (MetaId -> Elims -> Term
MetaV MetaId
m Elims
vs)
case Term
v of
MetaV m :: MetaId
m vs :: Elims
vs -> LevelAtom' Term -> ReduceM (LevelAtom' Term)
forall (m :: * -> *) a. Monad m => a -> m a
return (LevelAtom' Term -> ReduceM (LevelAtom' Term))
-> LevelAtom' Term -> ReduceM (LevelAtom' Term)
forall a b. (a -> b) -> a -> b
$ MetaId -> Elims -> LevelAtom' Term
forall t. MetaId -> [Elim' t] -> LevelAtom' t
MetaLevel MetaId
m Elims
vs
_ -> LevelAtom' Term -> ReduceM (LevelAtom' Term)
forall (m :: * -> *) a. Monad m => a -> m a
return (LevelAtom' Term -> ReduceM (LevelAtom' Term))
-> LevelAtom' Term -> ReduceM (LevelAtom' Term)
forall a b. (a -> b) -> a -> b
$ Term -> LevelAtom' Term
forall t. t -> LevelAtom' t
UnreducedLevel Term
v
UnreducedLevel l :: Term
l -> Term -> LevelAtom' Term
forall t. t -> LevelAtom' t
UnreducedLevel (Term -> LevelAtom' Term)
-> ReduceM Term -> ReduceM (LevelAtom' Term)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term -> ReduceM Term
forall t. Instantiate t => t -> ReduceM t
instantiate' Term
l
_ -> LevelAtom' Term -> ReduceM (LevelAtom' Term)
forall (m :: * -> *) a. Monad m => a -> m a
return LevelAtom' Term
l
instance Instantiate a => Instantiate (Blocked a) where
instantiate' :: Blocked a -> ReduceM (Blocked a)
instantiate' v :: Blocked a
v@NotBlocked{} = Blocked a -> ReduceM (Blocked a)
forall (m :: * -> *) a. Monad m => a -> m a
return Blocked a
v
instantiate' v :: Blocked a
v@(Blocked x :: MetaId
x u :: a
u) = do
MetaInstantiation
mi <- MetaVariable -> MetaInstantiation
mvInstantiation (MetaVariable -> MetaInstantiation)
-> ReduceM MetaVariable -> ReduceM MetaInstantiation
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MetaId -> ReduceM MetaVariable
forall (m :: * -> *).
(MonadFail m, ReadTCState m) =>
MetaId -> m MetaVariable
lookupMeta MetaId
x
case MetaInstantiation
mi of
InstV{} -> a -> Blocked a
forall a. a -> Blocked a
notBlocked (a -> Blocked a) -> ReduceM a -> ReduceM (Blocked a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> ReduceM a
forall t. Instantiate t => t -> ReduceM t
instantiate' a
u
Open -> Blocked a -> ReduceM (Blocked a)
forall (m :: * -> *) a. Monad m => a -> m a
return Blocked a
v
OpenInstance -> Blocked a -> ReduceM (Blocked a)
forall (m :: * -> *) a. Monad m => a -> m a
return Blocked a
v
BlockedConst{} -> Blocked a -> ReduceM (Blocked a)
forall (m :: * -> *) a. Monad m => a -> m a
return Blocked a
v
PostponedTypeCheckingProblem{} -> Blocked a -> ReduceM (Blocked a)
forall (m :: * -> *) a. Monad m => a -> m a
return Blocked a
v
instance Instantiate Sort where
instantiate' :: Sort -> ReduceM Sort
instantiate' s :: Sort
s = case Sort
s of
MetaS x :: MetaId
x es :: Elims
es -> Term -> ReduceM Term
forall t. Instantiate t => t -> ReduceM t
instantiate' (MetaId -> Elims -> Term
MetaV MetaId
x Elims
es) ReduceM Term -> (Term -> ReduceM Sort) -> ReduceM Sort
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Sort s' :: Sort
s' -> Sort -> ReduceM Sort
forall (m :: * -> *) a. Monad m => a -> m a
return Sort
s'
MetaV x' :: MetaId
x' es' :: Elims
es' -> Sort -> ReduceM Sort
forall (m :: * -> *) a. Monad m => a -> m a
return (Sort -> ReduceM Sort) -> Sort -> ReduceM Sort
forall a b. (a -> b) -> a -> b
$ MetaId -> Elims -> Sort
forall t. MetaId -> [Elim' t] -> Sort' t
MetaS MetaId
x' Elims
es'
Def d :: QName
d es' :: Elims
es' -> Sort -> ReduceM Sort
forall (m :: * -> *) a. Monad m => a -> m a
return (Sort -> ReduceM Sort) -> Sort -> ReduceM Sort
forall a b. (a -> b) -> a -> b
$ QName -> Elims -> Sort
forall t. QName -> [Elim' t] -> Sort' t
DefS QName
d Elims
es'
_ -> ReduceM Sort
forall a. HasCallStack => a
__IMPOSSIBLE__
_ -> Sort -> ReduceM Sort
forall (m :: * -> *) a. Monad m => a -> m a
return Sort
s
instance (Instantiate t, Instantiate e) => Instantiate (Dom' t e) where
instantiate' :: Dom' t e -> ReduceM (Dom' t e)
instantiate' (Dom i :: ArgInfo
i fin :: Bool
fin n :: Maybe NamedName
n tac :: Maybe t
tac x :: e
x) = ArgInfo -> Bool -> Maybe NamedName -> Maybe t -> e -> Dom' t e
forall t e.
ArgInfo -> Bool -> Maybe NamedName -> Maybe t -> e -> Dom' t e
Dom ArgInfo
i Bool
fin Maybe NamedName
n (Maybe t -> e -> Dom' t e)
-> ReduceM (Maybe t) -> ReduceM (e -> Dom' t e)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe t -> ReduceM (Maybe t)
forall t. Instantiate t => t -> ReduceM t
instantiate' Maybe t
tac ReduceM (e -> Dom' t e) -> ReduceM e -> ReduceM (Dom' t e)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> e -> ReduceM e
forall t. Instantiate t => t -> ReduceM t
instantiate' e
x
instance Instantiate a => Instantiate (Closure a) where
instantiate' :: Closure a -> ReduceM (Closure a)
instantiate' cl :: Closure a
cl = do
a
x <- Closure a -> (a -> ReduceM a) -> ReduceM a
forall a c b. LensClosure a c => c -> (a -> ReduceM b) -> ReduceM b
enterClosure Closure a
cl a -> ReduceM a
forall t. Instantiate t => t -> ReduceM t
instantiate'
Closure a -> ReduceM (Closure a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Closure a -> ReduceM (Closure a))
-> Closure a -> ReduceM (Closure a)
forall a b. (a -> b) -> a -> b
$ Closure a
cl { clValue :: a
clValue = a
x }
instance Instantiate Constraint where
instantiate' :: Constraint -> ReduceM Constraint
instantiate' (ValueCmp cmp :: Comparison
cmp t :: CompareAs
t u :: Term
u v :: Term
v) = do
(t :: CompareAs
t,u :: Term
u,v :: Term
v) <- (CompareAs, Term, Term) -> ReduceM (CompareAs, Term, Term)
forall t. Instantiate t => t -> ReduceM t
instantiate' (CompareAs
t,Term
u,Term
v)
Constraint -> ReduceM Constraint
forall (m :: * -> *) a. Monad m => a -> m a
return (Constraint -> ReduceM Constraint)
-> Constraint -> ReduceM Constraint
forall a b. (a -> b) -> a -> b
$ Comparison -> CompareAs -> Term -> Term -> Constraint
ValueCmp Comparison
cmp CompareAs
t Term
u Term
v
instantiate' (ValueCmpOnFace cmp :: Comparison
cmp p :: Term
p t :: Type
t u :: Term
u v :: Term
v) = do
((p :: Term
p,t :: Type
t),u :: Term
u,v :: Term
v) <- ((Term, Type), Term, Term) -> ReduceM ((Term, Type), Term, Term)
forall t. Instantiate t => t -> ReduceM t
instantiate' ((Term
p,Type
t),Term
u,Term
v)
Constraint -> ReduceM Constraint
forall (m :: * -> *) a. Monad m => a -> m a
return (Constraint -> ReduceM Constraint)
-> Constraint -> ReduceM Constraint
forall a b. (a -> b) -> a -> b
$ Comparison -> Term -> Type -> Term -> Term -> Constraint
ValueCmpOnFace Comparison
cmp Term
p Type
t Term
u Term
v
instantiate' (ElimCmp cmp :: [Polarity]
cmp fs :: [IsForced]
fs t :: Type
t v :: Term
v as :: Elims
as bs :: Elims
bs) =
[Polarity]
-> [IsForced] -> Type -> Term -> Elims -> Elims -> Constraint
ElimCmp [Polarity]
cmp [IsForced]
fs (Type -> Term -> Elims -> Elims -> Constraint)
-> ReduceM Type -> ReduceM (Term -> Elims -> Elims -> Constraint)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Type -> ReduceM Type
forall t. Instantiate t => t -> ReduceM t
instantiate' Type
t ReduceM (Term -> Elims -> Elims -> Constraint)
-> ReduceM Term -> ReduceM (Elims -> Elims -> Constraint)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Term -> ReduceM Term
forall t. Instantiate t => t -> ReduceM t
instantiate' Term
v ReduceM (Elims -> Elims -> Constraint)
-> ReduceM Elims -> ReduceM (Elims -> Constraint)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Elims -> ReduceM Elims
forall t. Instantiate t => t -> ReduceM t
instantiate' Elims
as ReduceM (Elims -> Constraint)
-> ReduceM Elims -> ReduceM Constraint
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Elims -> ReduceM Elims
forall t. Instantiate t => t -> ReduceM t
instantiate' Elims
bs
instantiate' (LevelCmp cmp :: Comparison
cmp u :: Level
u v :: Level
v) = (Level -> Level -> Constraint) -> (Level, Level) -> Constraint
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (Comparison -> Level -> Level -> Constraint
LevelCmp Comparison
cmp) ((Level, Level) -> Constraint)
-> ReduceM (Level, Level) -> ReduceM Constraint
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Level, Level) -> ReduceM (Level, Level)
forall t. Instantiate t => t -> ReduceM t
instantiate' (Level
u,Level
v)
instantiate' (TelCmp a :: Type
a b :: Type
b cmp :: Comparison
cmp tela :: Telescope
tela telb :: Telescope
telb) = (Telescope -> Telescope -> Constraint)
-> (Telescope, Telescope) -> Constraint
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (Type -> Type -> Comparison -> Telescope -> Telescope -> Constraint
TelCmp Type
a Type
b Comparison
cmp) ((Telescope, Telescope) -> Constraint)
-> ReduceM (Telescope, Telescope) -> ReduceM Constraint
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Telescope, Telescope) -> ReduceM (Telescope, Telescope)
forall t. Instantiate t => t -> ReduceM t
instantiate' (Telescope
tela,Telescope
telb)
instantiate' (SortCmp cmp :: Comparison
cmp a :: Sort
a b :: Sort
b) = (Sort -> Sort -> Constraint) -> (Sort, Sort) -> Constraint
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (Comparison -> Sort -> Sort -> Constraint
SortCmp Comparison
cmp) ((Sort, Sort) -> Constraint)
-> ReduceM (Sort, Sort) -> ReduceM Constraint
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Sort, Sort) -> ReduceM (Sort, Sort)
forall t. Instantiate t => t -> ReduceM t
instantiate' (Sort
a,Sort
b)
instantiate' (Guarded c :: Constraint
c pid :: ProblemId
pid) = Constraint -> ProblemId -> Constraint
Guarded (Constraint -> ProblemId -> Constraint)
-> ReduceM Constraint -> ReduceM (ProblemId -> Constraint)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Constraint -> ReduceM Constraint
forall t. Instantiate t => t -> ReduceM t
instantiate' Constraint
c ReduceM (ProblemId -> Constraint)
-> ReduceM ProblemId -> ReduceM Constraint
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ProblemId -> ReduceM ProblemId
forall (f :: * -> *) a. Applicative f => a -> f a
pure ProblemId
pid
instantiate' (UnBlock m :: MetaId
m) = Constraint -> ReduceM Constraint
forall (m :: * -> *) a. Monad m => a -> m a
return (Constraint -> ReduceM Constraint)
-> Constraint -> ReduceM Constraint
forall a b. (a -> b) -> a -> b
$ MetaId -> Constraint
UnBlock MetaId
m
instantiate' (FindInstance m :: MetaId
m b :: Maybe MetaId
b args :: Maybe [Candidate]
args) = MetaId -> Maybe MetaId -> Maybe [Candidate] -> Constraint
FindInstance MetaId
m Maybe MetaId
b (Maybe [Candidate] -> Constraint)
-> ReduceM (Maybe [Candidate]) -> ReduceM Constraint
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Candidate] -> ReduceM [Candidate])
-> Maybe [Candidate] -> ReduceM (Maybe [Candidate])
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM [Candidate] -> ReduceM [Candidate]
forall t. Instantiate t => t -> ReduceM t
instantiate' Maybe [Candidate]
args
instantiate' (IsEmpty r :: Range
r t :: Type
t) = Range -> Type -> Constraint
IsEmpty Range
r (Type -> Constraint) -> ReduceM Type -> ReduceM Constraint
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Type -> ReduceM Type
forall t. Instantiate t => t -> ReduceM t
instantiate' Type
t
instantiate' (CheckSizeLtSat t :: Term
t) = Term -> Constraint
CheckSizeLtSat (Term -> Constraint) -> ReduceM Term -> ReduceM Constraint
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term -> ReduceM Term
forall t. Instantiate t => t -> ReduceM t
instantiate' Term
t
instantiate' c :: Constraint
c@CheckFunDef{} = Constraint -> ReduceM Constraint
forall (m :: * -> *) a. Monad m => a -> m a
return Constraint
c
instantiate' (HasBiggerSort a :: Sort
a) = Sort -> Constraint
HasBiggerSort (Sort -> Constraint) -> ReduceM Sort -> ReduceM Constraint
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sort -> ReduceM Sort
forall t. Instantiate t => t -> ReduceM t
instantiate' Sort
a
instantiate' (HasPTSRule a :: Dom Type
a b :: Abs Sort
b) = (Dom Type -> Abs Sort -> Constraint)
-> (Dom Type, Abs Sort) -> Constraint
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Dom Type -> Abs Sort -> Constraint
HasPTSRule ((Dom Type, Abs Sort) -> Constraint)
-> ReduceM (Dom Type, Abs Sort) -> ReduceM Constraint
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Dom Type, Abs Sort) -> ReduceM (Dom Type, Abs Sort)
forall t. Instantiate t => t -> ReduceM t
instantiate' (Dom Type
a,Abs Sort
b)
instantiate' (UnquoteTactic m :: Maybe MetaId
m t :: Term
t h :: Term
h g :: Type
g) = Maybe MetaId -> Term -> Term -> Type -> Constraint
UnquoteTactic Maybe MetaId
m (Term -> Term -> Type -> Constraint)
-> ReduceM Term -> ReduceM (Term -> Type -> Constraint)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term -> ReduceM Term
forall t. Instantiate t => t -> ReduceM t
instantiate' Term
t ReduceM (Term -> Type -> Constraint)
-> ReduceM Term -> ReduceM (Type -> Constraint)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Term -> ReduceM Term
forall t. Instantiate t => t -> ReduceM t
instantiate' Term
h ReduceM (Type -> Constraint) -> ReduceM Type -> ReduceM Constraint
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Type -> ReduceM Type
forall t. Instantiate t => t -> ReduceM t
instantiate' Type
g
instantiate' c :: Constraint
c@CheckMetaInst{} = Constraint -> ReduceM Constraint
forall (m :: * -> *) a. Monad m => a -> m a
return Constraint
c
instance Instantiate CompareAs where
instantiate' :: CompareAs -> ReduceM CompareAs
instantiate' (AsTermsOf a :: Type
a) = Type -> CompareAs
AsTermsOf (Type -> CompareAs) -> ReduceM Type -> ReduceM CompareAs
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Type -> ReduceM Type
forall t. Instantiate t => t -> ReduceM t
instantiate' Type
a
instantiate' AsSizes = CompareAs -> ReduceM CompareAs
forall (m :: * -> *) a. Monad m => a -> m a
return CompareAs
AsSizes
instantiate' AsTypes = CompareAs -> ReduceM CompareAs
forall (m :: * -> *) a. Monad m => a -> m a
return CompareAs
AsTypes
instance Instantiate Candidate where
instantiate' :: Candidate -> ReduceM Candidate
instantiate' (Candidate u :: Term
u t :: Type
t ov :: Bool
ov) = Term -> Type -> Bool -> Candidate
Candidate (Term -> Type -> Bool -> Candidate)
-> ReduceM Term -> ReduceM (Type -> Bool -> Candidate)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term -> ReduceM Term
forall t. Instantiate t => t -> ReduceM t
instantiate' Term
u ReduceM (Type -> Bool -> Candidate)
-> ReduceM Type -> ReduceM (Bool -> Candidate)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Type -> ReduceM Type
forall t. Instantiate t => t -> ReduceM t
instantiate' Type
t ReduceM (Bool -> Candidate) -> ReduceM Bool -> ReduceM Candidate
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Bool -> ReduceM Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
ov
instance Instantiate EqualityView where
instantiate' :: EqualityView -> ReduceM EqualityView
instantiate' (OtherType t :: Type
t) = Type -> EqualityView
OtherType
(Type -> EqualityView) -> ReduceM Type -> ReduceM EqualityView
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Type -> ReduceM Type
forall t. Instantiate t => t -> ReduceM t
instantiate' Type
t
instantiate' (EqualityType s :: Sort
s eq :: QName
eq l :: [Arg Term]
l t :: Arg Term
t a :: Arg Term
a b :: Arg Term
b) = Sort
-> QName
-> [Arg Term]
-> Arg Term
-> Arg Term
-> Arg Term
-> EqualityView
EqualityType
(Sort
-> QName
-> [Arg Term]
-> Arg Term
-> Arg Term
-> Arg Term
-> EqualityView)
-> ReduceM Sort
-> ReduceM
(QName
-> [Arg Term] -> Arg Term -> Arg Term -> Arg Term -> EqualityView)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sort -> ReduceM Sort
forall t. Instantiate t => t -> ReduceM t
instantiate' Sort
s
ReduceM
(QName
-> [Arg Term] -> Arg Term -> Arg Term -> Arg Term -> EqualityView)
-> ReduceM QName
-> ReduceM
([Arg Term] -> Arg Term -> Arg Term -> Arg Term -> EqualityView)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> QName -> ReduceM QName
forall (m :: * -> *) a. Monad m => a -> m a
return QName
eq
ReduceM
([Arg Term] -> Arg Term -> Arg Term -> Arg Term -> EqualityView)
-> ReduceM [Arg Term]
-> ReduceM (Arg Term -> Arg Term -> Arg Term -> EqualityView)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Arg Term -> ReduceM (Arg Term))
-> [Arg Term] -> ReduceM [Arg Term]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Arg Term -> ReduceM (Arg Term)
forall t. Instantiate t => t -> ReduceM t
instantiate' [Arg Term]
l
ReduceM (Arg Term -> Arg Term -> Arg Term -> EqualityView)
-> ReduceM (Arg Term)
-> ReduceM (Arg Term -> Arg Term -> EqualityView)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Arg Term -> ReduceM (Arg Term)
forall t. Instantiate t => t -> ReduceM t
instantiate' Arg Term
t
ReduceM (Arg Term -> Arg Term -> EqualityView)
-> ReduceM (Arg Term) -> ReduceM (Arg Term -> EqualityView)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Arg Term -> ReduceM (Arg Term)
forall t. Instantiate t => t -> ReduceM t
instantiate' Arg Term
a
ReduceM (Arg Term -> EqualityView)
-> ReduceM (Arg Term) -> ReduceM EqualityView
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Arg Term -> ReduceM (Arg Term)
forall t. Instantiate t => t -> ReduceM t
instantiate' Arg Term
b
class IsMeta a where
isMeta :: HasBuiltins m => a -> m (Maybe MetaId)
instance IsMeta Term where
isMeta :: Term -> m (Maybe MetaId)
isMeta (MetaV m :: MetaId
m _) = Maybe MetaId -> m (Maybe MetaId)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe MetaId -> m (Maybe MetaId))
-> Maybe MetaId -> m (Maybe MetaId)
forall a b. (a -> b) -> a -> b
$ MetaId -> Maybe MetaId
forall a. a -> Maybe a
Just MetaId
m
isMeta _ = Maybe MetaId -> m (Maybe MetaId)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe MetaId
forall a. Maybe a
Nothing
instance IsMeta Type where
isMeta :: Type -> m (Maybe MetaId)
isMeta = Term -> m (Maybe MetaId)
forall a (m :: * -> *).
(IsMeta a, HasBuiltins m) =>
a -> m (Maybe MetaId)
isMeta (Term -> m (Maybe MetaId))
-> (Type -> Term) -> Type -> m (Maybe MetaId)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type -> Term
forall t a. Type'' t a -> a
unEl
instance IsMeta Level where
isMeta :: Level -> m (Maybe MetaId)
isMeta = Term -> m (Maybe MetaId)
forall a (m :: * -> *).
(IsMeta a, HasBuiltins m) =>
a -> m (Maybe MetaId)
isMeta (Term -> m (Maybe MetaId))
-> (Level -> m Term) -> Level -> m (Maybe MetaId)
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Level -> m Term
forall (m :: * -> *). HasBuiltins m => Level -> m Term
reallyUnLevelView
instance IsMeta Sort where
isMeta :: Sort -> m (Maybe MetaId)
isMeta (MetaS m :: MetaId
m _) = Maybe MetaId -> m (Maybe MetaId)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe MetaId -> m (Maybe MetaId))
-> Maybe MetaId -> m (Maybe MetaId)
forall a b. (a -> b) -> a -> b
$ MetaId -> Maybe MetaId
forall a. a -> Maybe a
Just MetaId
m
isMeta _ = Maybe MetaId -> m (Maybe MetaId)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe MetaId
forall a. Maybe a
Nothing
instance IsMeta CompareAs where
isMeta :: CompareAs -> m (Maybe MetaId)
isMeta (AsTermsOf a :: Type
a) = Type -> m (Maybe MetaId)
forall a (m :: * -> *).
(IsMeta a, HasBuiltins m) =>
a -> m (Maybe MetaId)
isMeta Type
a
isMeta AsSizes = Maybe MetaId -> m (Maybe MetaId)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe MetaId
forall a. Maybe a
Nothing
isMeta AsTypes = Maybe MetaId -> m (Maybe MetaId)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe MetaId
forall a. Maybe a
Nothing
ifBlocked
:: (Reduce t, IsMeta t, MonadReduce m, HasBuiltins m)
=> t -> (MetaId -> t -> m a) -> (NotBlocked -> t -> m a) -> m a
ifBlocked :: t -> (MetaId -> t -> m a) -> (NotBlocked -> t -> m a) -> m a
ifBlocked t :: t
t blocked :: MetaId -> t -> m a
blocked unblocked :: NotBlocked -> t -> m a
unblocked = do
Blocked t
t <- t -> m (Blocked t)
forall a (m :: * -> *).
(Reduce a, MonadReduce m) =>
a -> m (Blocked a)
reduceB t
t
case Blocked t
t of
Blocked m :: MetaId
m t :: t
t -> MetaId -> t -> m a
blocked MetaId
m t
t
NotBlocked nb :: NotBlocked
nb t :: t
t -> t -> m (Maybe MetaId)
forall a (m :: * -> *).
(IsMeta a, HasBuiltins m) =>
a -> m (Maybe MetaId)
isMeta t
t m (Maybe MetaId) -> (Maybe MetaId -> m a) -> m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Just m :: MetaId
m -> MetaId -> t -> m a
blocked MetaId
m t
t
Nothing -> NotBlocked -> t -> m a
unblocked NotBlocked
nb t
t
isBlocked
:: (Reduce t, IsMeta t, MonadReduce m, HasBuiltins m)
=> t -> m (Maybe MetaId)
isBlocked :: t -> m (Maybe MetaId)
isBlocked t :: t
t = t
-> (MetaId -> t -> m (Maybe MetaId))
-> (NotBlocked -> t -> m (Maybe MetaId))
-> m (Maybe MetaId)
forall t (m :: * -> *) a.
(Reduce t, IsMeta t, MonadReduce m, HasBuiltins m) =>
t -> (MetaId -> t -> m a) -> (NotBlocked -> t -> m a) -> m a
ifBlocked t
t (\m :: MetaId
m _ -> Maybe MetaId -> m (Maybe MetaId)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe MetaId -> m (Maybe MetaId))
-> Maybe MetaId -> m (Maybe MetaId)
forall a b. (a -> b) -> a -> b
$ MetaId -> Maybe MetaId
forall a. a -> Maybe a
Just MetaId
m) (\_ _ -> Maybe MetaId -> m (Maybe MetaId)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe MetaId
forall a. Maybe a
Nothing)
class Reduce t where
reduce' :: t -> ReduceM t
reduceB' :: t -> ReduceM (Blocked t)
reduce' t :: t
t = Blocked t -> t
forall t. Blocked t -> t
ignoreBlocking (Blocked t -> t) -> ReduceM (Blocked t) -> ReduceM t
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> t -> ReduceM (Blocked t)
forall t. Reduce t => t -> ReduceM (Blocked t)
reduceB' t
t
reduceB' t :: t
t = t -> Blocked t
forall a. a -> Blocked a
notBlocked (t -> Blocked t) -> ReduceM t -> ReduceM (Blocked t)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> t -> ReduceM t
forall t. Reduce t => t -> ReduceM t
reduce' t
t
instance Reduce Type where
reduce' :: Type -> ReduceM Type
reduce' (El s :: Sort
s t :: Term
t) = ReduceM Type -> ReduceM Type
forall (m :: * -> *) a.
(MonadTCEnv m, HasOptions m, MonadDebug m) =>
m a -> m a
workOnTypes (ReduceM Type -> ReduceM Type) -> ReduceM Type -> ReduceM Type
forall a b. (a -> b) -> a -> b
$ Sort -> Term -> Type
forall t a. Sort' t -> a -> Type'' t a
El Sort
s (Term -> Type) -> ReduceM Term -> ReduceM Type
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term -> ReduceM Term
forall t. Reduce t => t -> ReduceM t
reduce' Term
t
reduceB' :: Type -> ReduceM (Blocked Type)
reduceB' (El s :: Sort
s t :: Term
t) = ReduceM (Blocked Type) -> ReduceM (Blocked Type)
forall (m :: * -> *) a.
(MonadTCEnv m, HasOptions m, MonadDebug m) =>
m a -> m a
workOnTypes (ReduceM (Blocked Type) -> ReduceM (Blocked Type))
-> ReduceM (Blocked Type) -> ReduceM (Blocked Type)
forall a b. (a -> b) -> a -> b
$ (Term -> Type) -> Blocked Term -> Blocked Type
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Sort -> Term -> Type
forall t a. Sort' t -> a -> Type'' t a
El Sort
s) (Blocked Term -> Blocked Type)
-> ReduceM (Blocked Term) -> ReduceM (Blocked Type)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term -> ReduceM (Blocked Term)
forall t. Reduce t => t -> ReduceM (Blocked t)
reduceB' Term
t
instance Reduce Sort where
reduce' :: Sort -> ReduceM Sort
reduce' s :: Sort
s = do
Sort
s <- Sort -> ReduceM Sort
forall t. Instantiate t => t -> ReduceM t
instantiate' Sort
s
case Sort
s of
PiSort a :: Dom Type
a s2 :: Abs Sort
s2 -> do
(s1' :: Sort
s1' , s2' :: Abs Sort
s2') <- (Sort, Abs Sort) -> ReduceM (Sort, Abs Sort)
forall t. Reduce t => t -> ReduceM t
reduce' (Dom Type -> Sort
forall a. LensSort a => a -> Sort
getSort Dom Type
a , Abs Sort
s2)
let a' :: Dom Type
a' = Lens' Sort (Dom Type) -> LensSet Sort (Dom Type)
forall i o. Lens' i o -> LensSet i o
set forall a. LensSort a => Lens' Sort a
Lens' Sort (Dom Type)
lensSort Sort
s1' Dom Type
a
ReduceM Sort
-> (Sort -> ReduceM Sort) -> Maybe Sort -> ReduceM Sort
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Sort -> ReduceM Sort
forall (m :: * -> *) a. Monad m => a -> m a
return (Sort -> ReduceM Sort) -> Sort -> ReduceM Sort
forall a b. (a -> b) -> a -> b
$ Dom Type -> Abs Sort -> Sort
forall t. Dom' t (Type'' t t) -> Abs (Sort' t) -> Sort' t
PiSort Dom Type
a' Abs Sort
s2') Sort -> ReduceM Sort
forall t. Reduce t => t -> ReduceM t
reduce' (Maybe Sort -> ReduceM Sort) -> Maybe Sort -> ReduceM Sort
forall a b. (a -> b) -> a -> b
$ Dom Type -> Abs Sort -> Maybe Sort
piSort' Dom Type
a' Abs Sort
s2'
FunSort s1 :: Sort
s1 s2 :: Sort
s2 -> do
(s1' :: Sort
s1' , s2' :: Sort
s2') <- (Sort, Sort) -> ReduceM (Sort, Sort)
forall a (m :: * -> *). (Reduce a, MonadReduce m) => a -> m a
reduce (Sort
s1 , Sort
s2)
ReduceM Sort
-> (Sort -> ReduceM Sort) -> Maybe Sort -> ReduceM Sort
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Sort -> ReduceM Sort
forall (m :: * -> *) a. Monad m => a -> m a
return (Sort -> ReduceM Sort) -> Sort -> ReduceM Sort
forall a b. (a -> b) -> a -> b
$ Sort -> Sort -> Sort
forall t. Sort' t -> Sort' t -> Sort' t
FunSort Sort
s1' Sort
s2') Sort -> ReduceM Sort
forall t. Reduce t => t -> ReduceM t
reduce' (Maybe Sort -> ReduceM Sort) -> Maybe Sort -> ReduceM Sort
forall a b. (a -> b) -> a -> b
$ Sort -> Sort -> Maybe Sort
funSort' Sort
s1' Sort
s2'
UnivSort s' :: Sort
s' -> do
Sort
s' <- Sort -> ReduceM Sort
forall t. Reduce t => t -> ReduceM t
reduce' Sort
s'
Maybe Sort
ui <- ReduceM (Maybe Sort)
forall (m :: * -> *). HasOptions m => m (Maybe Sort)
univInf
Maybe Sort
-> ReduceM Sort -> (Sort -> ReduceM Sort) -> ReduceM Sort
forall a b. Maybe a -> b -> (a -> b) -> b
caseMaybe (Maybe Sort -> Sort -> Maybe Sort
univSort' Maybe Sort
ui Sort
s') (Sort -> ReduceM Sort
forall (m :: * -> *) a. Monad m => a -> m a
return (Sort -> ReduceM Sort) -> Sort -> ReduceM Sort
forall a b. (a -> b) -> a -> b
$ Sort -> Sort
forall t. Sort' t -> Sort' t
UnivSort Sort
s') Sort -> ReduceM Sort
forall t. Reduce t => t -> ReduceM t
reduce'
Prop s' :: Level
s' -> Level -> Sort
forall t. Level' t -> Sort' t
Prop (Level -> Sort) -> ReduceM Level -> ReduceM Sort
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Level -> ReduceM Level
forall t. Reduce t => t -> ReduceM t
reduce' Level
s'
Type s' :: Level
s' -> Level -> Sort
forall t. Level' t -> Sort' t
Type (Level -> Sort) -> ReduceM Level -> ReduceM Sort
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Level -> ReduceM Level
forall t. Reduce t => t -> ReduceM t
reduce' Level
s'
Inf -> Sort -> ReduceM Sort
forall (m :: * -> *) a. Monad m => a -> m a
return Sort
forall t. Sort' t
Inf
SizeUniv -> Sort -> ReduceM Sort
forall (m :: * -> *) a. Monad m => a -> m a
return Sort
forall t. Sort' t
SizeUniv
MetaS x :: MetaId
x es :: Elims
es -> Sort -> ReduceM Sort
forall (m :: * -> *) a. Monad m => a -> m a
return Sort
s
DefS d :: QName
d es :: Elims
es -> Sort -> ReduceM Sort
forall (m :: * -> *) a. Monad m => a -> m a
return Sort
s
DummyS{} -> Sort -> ReduceM Sort
forall (m :: * -> *) a. Monad m => a -> m a
return Sort
s
instance Reduce Elim where
reduce' :: Elim -> ReduceM Elim
reduce' (Apply v :: Arg Term
v) = Arg Term -> Elim
forall a. Arg a -> Elim' a
Apply (Arg Term -> Elim) -> ReduceM (Arg Term) -> ReduceM Elim
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Arg Term -> ReduceM (Arg Term)
forall t. Reduce t => t -> ReduceM t
reduce' Arg Term
v
reduce' (Proj o :: ProjOrigin
o f :: QName
f)= Elim -> ReduceM Elim
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Elim -> ReduceM Elim) -> Elim -> ReduceM Elim
forall a b. (a -> b) -> a -> b
$ ProjOrigin -> QName -> Elim
forall a. ProjOrigin -> QName -> Elim' a
Proj ProjOrigin
o QName
f
reduce' (IApply x :: Term
x y :: Term
y v :: Term
v) = Term -> Term -> Term -> Elim
forall a. a -> a -> a -> Elim' a
IApply (Term -> Term -> Term -> Elim)
-> ReduceM Term -> ReduceM (Term -> Term -> Elim)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term -> ReduceM Term
forall t. Reduce t => t -> ReduceM t
reduce' Term
x ReduceM (Term -> Term -> Elim)
-> ReduceM Term -> ReduceM (Term -> Elim)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Term -> ReduceM Term
forall t. Reduce t => t -> ReduceM t
reduce' Term
y ReduceM (Term -> Elim) -> ReduceM Term -> ReduceM Elim
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Term -> ReduceM Term
forall t. Reduce t => t -> ReduceM t
reduce' Term
v
instance Reduce Level where
reduce' :: Level -> ReduceM Level
reduce' (Max m :: Integer
m as :: [PlusLevel' Term]
as) = Integer -> [PlusLevel' Term] -> Level
levelMax Integer
m ([PlusLevel' Term] -> Level)
-> ReduceM [PlusLevel' Term] -> ReduceM Level
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PlusLevel' Term -> ReduceM (PlusLevel' Term))
-> [PlusLevel' Term] -> ReduceM [PlusLevel' Term]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM PlusLevel' Term -> ReduceM (PlusLevel' Term)
forall t. Reduce t => t -> ReduceM t
reduce' [PlusLevel' Term]
as
reduceB' :: Level -> ReduceM (Blocked Level)
reduceB' (Max m :: Integer
m as :: [PlusLevel' Term]
as) = ([PlusLevel' Term] -> Level)
-> Blocked [PlusLevel' Term] -> Blocked Level
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Integer -> [PlusLevel' Term] -> Level
levelMax Integer
m) (Blocked [PlusLevel' Term] -> Blocked Level)
-> ([Blocked (PlusLevel' Term)] -> Blocked [PlusLevel' Term])
-> [Blocked (PlusLevel' Term)]
-> Blocked Level
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Blocked (PlusLevel' Term) -> Blocked (PlusLevel' Term))
-> [Blocked (PlusLevel' Term)] -> Blocked [PlusLevel' Term]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Blocked (PlusLevel' Term) -> Blocked (PlusLevel' Term)
forall a. a -> a
id ([Blocked (PlusLevel' Term)] -> Blocked Level)
-> ReduceM [Blocked (PlusLevel' Term)] -> ReduceM (Blocked Level)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PlusLevel' Term -> ReduceM (Blocked (PlusLevel' Term)))
-> [PlusLevel' Term] -> ReduceM [Blocked (PlusLevel' Term)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse PlusLevel' Term -> ReduceM (Blocked (PlusLevel' Term))
forall t. Reduce t => t -> ReduceM (Blocked t)
reduceB' [PlusLevel' Term]
as
instance Reduce PlusLevel where
reduceB' :: PlusLevel' Term -> ReduceM (Blocked (PlusLevel' Term))
reduceB' (Plus n :: Integer
n l :: LevelAtom' Term
l) = (LevelAtom' Term -> PlusLevel' Term)
-> Blocked (LevelAtom' Term) -> Blocked (PlusLevel' Term)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Integer -> LevelAtom' Term -> PlusLevel' Term
forall t. Integer -> LevelAtom' t -> PlusLevel' t
Plus Integer
n) (Blocked (LevelAtom' Term) -> Blocked (PlusLevel' Term))
-> ReduceM (Blocked (LevelAtom' Term))
-> ReduceM (Blocked (PlusLevel' Term))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LevelAtom' Term -> ReduceM (Blocked (LevelAtom' Term))
forall t. Reduce t => t -> ReduceM (Blocked t)
reduceB' LevelAtom' Term
l
instance Reduce LevelAtom where
reduceB' :: LevelAtom' Term -> ReduceM (Blocked (LevelAtom' Term))
reduceB' l :: LevelAtom' Term
l = case LevelAtom' Term
l of
MetaLevel m :: MetaId
m vs :: Elims
vs -> Term -> ReduceM (Blocked (LevelAtom' Term))
fromTm (MetaId -> Elims -> Term
MetaV MetaId
m Elims
vs)
NeutralLevel r :: NotBlocked
r v :: Term
v -> Blocked (LevelAtom' Term) -> ReduceM (Blocked (LevelAtom' Term))
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocked (LevelAtom' Term) -> ReduceM (Blocked (LevelAtom' Term)))
-> Blocked (LevelAtom' Term) -> ReduceM (Blocked (LevelAtom' Term))
forall a b. (a -> b) -> a -> b
$ NotBlocked -> LevelAtom' Term -> Blocked (LevelAtom' Term)
forall t. NotBlocked -> t -> Blocked t
NotBlocked NotBlocked
r (LevelAtom' Term -> Blocked (LevelAtom' Term))
-> LevelAtom' Term -> Blocked (LevelAtom' Term)
forall a b. (a -> b) -> a -> b
$ NotBlocked -> Term -> LevelAtom' Term
forall t. NotBlocked -> t -> LevelAtom' t
NeutralLevel NotBlocked
r Term
v
BlockedLevel m :: MetaId
m v :: Term
v ->
ReduceM Bool
-> ReduceM (Blocked (LevelAtom' Term))
-> ReduceM (Blocked (LevelAtom' Term))
-> ReduceM (Blocked (LevelAtom' Term))
forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifM (MetaId -> ReduceM Bool
forall a (m :: * -> *).
(IsInstantiatedMeta a, MonadFail m, ReadTCState m) =>
a -> m Bool
isInstantiatedMeta MetaId
m) (Term -> ReduceM (Blocked (LevelAtom' Term))
fromTm Term
v) (Blocked (LevelAtom' Term) -> ReduceM (Blocked (LevelAtom' Term))
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocked (LevelAtom' Term) -> ReduceM (Blocked (LevelAtom' Term)))
-> Blocked (LevelAtom' Term) -> ReduceM (Blocked (LevelAtom' Term))
forall a b. (a -> b) -> a -> b
$ MetaId -> LevelAtom' Term -> Blocked (LevelAtom' Term)
forall t. MetaId -> t -> Blocked t
Blocked MetaId
m (LevelAtom' Term -> Blocked (LevelAtom' Term))
-> LevelAtom' Term -> Blocked (LevelAtom' Term)
forall a b. (a -> b) -> a -> b
$ MetaId -> Term -> LevelAtom' Term
forall t. MetaId -> t -> LevelAtom' t
BlockedLevel MetaId
m Term
v)
UnreducedLevel v :: Term
v -> Term -> ReduceM (Blocked (LevelAtom' Term))
fromTm Term
v
where
fromTm :: Term -> ReduceM (Blocked (LevelAtom' Term))
fromTm v :: Term
v = do
Blocked Term
bv <- Term -> ReduceM (Blocked Term)
forall t. Reduce t => t -> ReduceM (Blocked t)
reduceB' Term
v
let v :: Term
v = Blocked Term -> Term
forall t. Blocked t -> t
ignoreBlocking Blocked Term
bv
case Blocked Term
bv of
NotBlocked r :: NotBlocked
r (MetaV m :: MetaId
m vs :: Elims
vs) -> Blocked (LevelAtom' Term) -> ReduceM (Blocked (LevelAtom' Term))
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocked (LevelAtom' Term) -> ReduceM (Blocked (LevelAtom' Term)))
-> Blocked (LevelAtom' Term) -> ReduceM (Blocked (LevelAtom' Term))
forall a b. (a -> b) -> a -> b
$ NotBlocked -> LevelAtom' Term -> Blocked (LevelAtom' Term)
forall t. NotBlocked -> t -> Blocked t
NotBlocked NotBlocked
r (LevelAtom' Term -> Blocked (LevelAtom' Term))
-> LevelAtom' Term -> Blocked (LevelAtom' Term)
forall a b. (a -> b) -> a -> b
$ MetaId -> Elims -> LevelAtom' Term
forall t. MetaId -> [Elim' t] -> LevelAtom' t
MetaLevel MetaId
m Elims
vs
Blocked m :: MetaId
m _ -> Blocked (LevelAtom' Term) -> ReduceM (Blocked (LevelAtom' Term))
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocked (LevelAtom' Term) -> ReduceM (Blocked (LevelAtom' Term)))
-> Blocked (LevelAtom' Term) -> ReduceM (Blocked (LevelAtom' Term))
forall a b. (a -> b) -> a -> b
$ MetaId -> LevelAtom' Term -> Blocked (LevelAtom' Term)
forall t. MetaId -> t -> Blocked t
Blocked MetaId
m (LevelAtom' Term -> Blocked (LevelAtom' Term))
-> LevelAtom' Term -> Blocked (LevelAtom' Term)
forall a b. (a -> b) -> a -> b
$ MetaId -> Term -> LevelAtom' Term
forall t. MetaId -> t -> LevelAtom' t
BlockedLevel MetaId
m Term
v
NotBlocked r :: NotBlocked
r _ -> Blocked (LevelAtom' Term) -> ReduceM (Blocked (LevelAtom' Term))
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocked (LevelAtom' Term) -> ReduceM (Blocked (LevelAtom' Term)))
-> Blocked (LevelAtom' Term) -> ReduceM (Blocked (LevelAtom' Term))
forall a b. (a -> b) -> a -> b
$ NotBlocked -> LevelAtom' Term -> Blocked (LevelAtom' Term)
forall t. NotBlocked -> t -> Blocked t
NotBlocked NotBlocked
r (LevelAtom' Term -> Blocked (LevelAtom' Term))
-> LevelAtom' Term -> Blocked (LevelAtom' Term)
forall a b. (a -> b) -> a -> b
$ NotBlocked -> Term -> LevelAtom' Term
forall t. NotBlocked -> t -> LevelAtom' t
NeutralLevel NotBlocked
r Term
v
instance (Subst t a, Reduce a) => Reduce (Abs a) where
reduce' :: Abs a -> ReduceM (Abs a)
reduce' b :: Abs a
b@(Abs x :: String
x _) = String -> a -> Abs a
forall a. String -> a -> Abs a
Abs String
x (a -> Abs a) -> ReduceM a -> ReduceM (Abs a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Abs a -> (a -> ReduceM a) -> ReduceM a
forall t a (m :: * -> *) b.
(Subst t a, MonadAddContext m) =>
Abs a -> (a -> m b) -> m b
underAbstraction_ Abs a
b a -> ReduceM a
forall t. Reduce t => t -> ReduceM t
reduce'
reduce' (NoAbs x :: String
x v :: a
v) = String -> a -> Abs a
forall a. String -> a -> Abs a
NoAbs String
x (a -> Abs a) -> ReduceM a -> ReduceM (Abs a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> ReduceM a
forall t. Reduce t => t -> ReduceM t
reduce' a
v
instance Reduce t => Reduce [t] where
reduce' :: [t] -> ReduceM [t]
reduce' = (t -> ReduceM t) -> [t] -> ReduceM [t]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse t -> ReduceM t
forall t. Reduce t => t -> ReduceM t
reduce'
instance Reduce t => Reduce (Arg t) where
reduce' :: Arg t -> ReduceM (Arg t)
reduce' a :: Arg t
a = case Arg t -> Relevance
forall a. LensRelevance a => a -> Relevance
getRelevance Arg t
a of
Irrelevant -> Arg t -> ReduceM (Arg t)
forall (m :: * -> *) a. Monad m => a -> m a
return Arg t
a
_ -> (t -> ReduceM t) -> Arg t -> ReduceM (Arg t)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse t -> ReduceM t
forall t. Reduce t => t -> ReduceM t
reduce' Arg t
a
reduceB' :: Arg t -> ReduceM (Blocked (Arg t))
reduceB' t :: Arg t
t = (Blocked t -> Blocked t) -> Arg (Blocked t) -> Blocked (Arg t)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Blocked t -> Blocked t
forall a. a -> a
id (Arg (Blocked t) -> Blocked (Arg t))
-> ReduceM (Arg (Blocked t)) -> ReduceM (Blocked (Arg t))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (t -> ReduceM (Blocked t)) -> Arg t -> ReduceM (Arg (Blocked t))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse t -> ReduceM (Blocked t)
forall t. Reduce t => t -> ReduceM (Blocked t)
reduceB' Arg t
t
instance Reduce t => Reduce (Dom t) where
reduce' :: Dom t -> ReduceM (Dom t)
reduce' = (t -> ReduceM t) -> Dom t -> ReduceM (Dom t)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse t -> ReduceM t
forall t. Reduce t => t -> ReduceM t
reduce'
reduceB' :: Dom t -> ReduceM (Blocked (Dom t))
reduceB' t :: Dom t
t = (Blocked t -> Blocked t)
-> Dom' Term (Blocked t) -> Blocked (Dom t)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Blocked t -> Blocked t
forall a. a -> a
id (Dom' Term (Blocked t) -> Blocked (Dom t))
-> ReduceM (Dom' Term (Blocked t)) -> ReduceM (Blocked (Dom t))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (t -> ReduceM (Blocked t))
-> Dom t -> ReduceM (Dom' Term (Blocked t))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse t -> ReduceM (Blocked t)
forall t. Reduce t => t -> ReduceM (Blocked t)
reduceB' Dom t
t
instance (Reduce a, Reduce b) => Reduce (a,b) where
reduce' :: (a, b) -> ReduceM (a, b)
reduce' (x :: a
x,y :: b
y) = (,) (a -> b -> (a, b)) -> ReduceM a -> ReduceM (b -> (a, b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> ReduceM a
forall t. Reduce t => t -> ReduceM t
reduce' a
x ReduceM (b -> (a, b)) -> ReduceM b -> ReduceM (a, b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> b -> ReduceM b
forall t. Reduce t => t -> ReduceM t
reduce' b
y
reduceB' :: (a, b) -> ReduceM (Blocked (a, b))
reduceB' (x :: a
x,y :: b
y) = do
Blocked a
x <- a -> ReduceM (Blocked a)
forall t. Reduce t => t -> ReduceM (Blocked t)
reduceB' a
x
Blocked b
y <- b -> ReduceM (Blocked b)
forall t. Reduce t => t -> ReduceM (Blocked t)
reduceB' b
y
let blk :: Blocked ()
blk = Blocked a -> Blocked ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Blocked a
x Blocked () -> Blocked () -> Blocked ()
forall a. Monoid a => a -> a -> a
`mappend` Blocked b -> Blocked ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Blocked b
y
xy :: (a, b)
xy = (Blocked a -> a
forall t. Blocked t -> t
ignoreBlocking Blocked a
x , Blocked b -> b
forall t. Blocked t -> t
ignoreBlocking Blocked b
y)
Blocked (a, b) -> ReduceM (Blocked (a, b))
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocked (a, b) -> ReduceM (Blocked (a, b)))
-> Blocked (a, b) -> ReduceM (Blocked (a, b))
forall a b. (a -> b) -> a -> b
$ Blocked ()
blk Blocked () -> (a, b) -> Blocked (a, b)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> (a, b)
xy
instance (Reduce a, Reduce b,Reduce c) => Reduce (a,b,c) where
reduce' :: (a, b, c) -> ReduceM (a, b, c)
reduce' (x :: a
x,y :: b
y,z :: c
z) = (,,) (a -> b -> c -> (a, b, c))
-> ReduceM a -> ReduceM (b -> c -> (a, b, c))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> ReduceM a
forall t. Reduce t => t -> ReduceM t
reduce' a
x ReduceM (b -> c -> (a, b, c))
-> ReduceM b -> ReduceM (c -> (a, b, c))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> b -> ReduceM b
forall t. Reduce t => t -> ReduceM t
reduce' b
y ReduceM (c -> (a, b, c)) -> ReduceM c -> ReduceM (a, b, c)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> c -> ReduceM c
forall t. Reduce t => t -> ReduceM t
reduce' c
z
reduceB' :: (a, b, c) -> ReduceM (Blocked (a, b, c))
reduceB' (x :: a
x,y :: b
y,z :: c
z) = do
Blocked a
x <- a -> ReduceM (Blocked a)
forall t. Reduce t => t -> ReduceM (Blocked t)
reduceB' a
x
Blocked b
y <- b -> ReduceM (Blocked b)
forall t. Reduce t => t -> ReduceM (Blocked t)
reduceB' b
y
Blocked c
z <- c -> ReduceM (Blocked c)
forall t. Reduce t => t -> ReduceM (Blocked t)
reduceB' c
z
let blk :: Blocked ()
blk = Blocked a -> Blocked ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Blocked a
x Blocked () -> Blocked () -> Blocked ()
forall a. Monoid a => a -> a -> a
`mappend` Blocked b -> Blocked ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Blocked b
y Blocked () -> Blocked () -> Blocked ()
forall a. Monoid a => a -> a -> a
`mappend` Blocked c -> Blocked ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Blocked c
z
xyz :: (a, b, c)
xyz = (Blocked a -> a
forall t. Blocked t -> t
ignoreBlocking Blocked a
x , Blocked b -> b
forall t. Blocked t -> t
ignoreBlocking Blocked b
y , Blocked c -> c
forall t. Blocked t -> t
ignoreBlocking Blocked c
z)
Blocked (a, b, c) -> ReduceM (Blocked (a, b, c))
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocked (a, b, c) -> ReduceM (Blocked (a, b, c)))
-> Blocked (a, b, c) -> ReduceM (Blocked (a, b, c))
forall a b. (a -> b) -> a -> b
$ Blocked ()
blk Blocked () -> (a, b, c) -> Blocked (a, b, c)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> (a, b, c)
xyz
reduceIApply :: ReduceM (Blocked Term) -> [Elim] -> ReduceM (Blocked Term)
reduceIApply :: ReduceM (Blocked Term) -> Elims -> ReduceM (Blocked Term)
reduceIApply = (Term -> ReduceM (Blocked Term))
-> ReduceM (Blocked Term) -> Elims -> ReduceM (Blocked Term)
reduceIApply' Term -> ReduceM (Blocked Term)
forall t. Reduce t => t -> ReduceM (Blocked t)
reduceB'
blockedOrMeta :: Blocked Term -> Blocked ()
blockedOrMeta :: Blocked Term -> Blocked ()
blockedOrMeta r :: Blocked Term
r =
case Blocked Term
r of
Blocked m :: MetaId
m _ -> MetaId -> () -> Blocked ()
forall t. MetaId -> t -> Blocked t
Blocked MetaId
m ()
NotBlocked _ (MetaV m :: MetaId
m _) -> MetaId -> () -> Blocked ()
forall t. MetaId -> t -> Blocked t
Blocked MetaId
m ()
NotBlocked i :: NotBlocked
i _ -> NotBlocked -> () -> Blocked ()
forall t. NotBlocked -> t -> Blocked t
NotBlocked NotBlocked
i ()
reduceIApply' :: (Term -> ReduceM (Blocked Term)) -> ReduceM (Blocked Term) -> [Elim] -> ReduceM (Blocked Term)
reduceIApply' :: (Term -> ReduceM (Blocked Term))
-> ReduceM (Blocked Term) -> Elims -> ReduceM (Blocked Term)
reduceIApply' red :: Term -> ReduceM (Blocked Term)
red d :: ReduceM (Blocked Term)
d (IApply x :: Term
x y :: Term
y r :: Term
r : es :: Elims
es) = do
Term -> IntervalView
view <- ReduceM (Term -> IntervalView)
forall (m :: * -> *). HasBuiltins m => m (Term -> IntervalView)
intervalView'
Blocked Term
r <- Term -> ReduceM (Blocked Term)
forall t. Reduce t => t -> ReduceM (Blocked t)
reduceB' Term
r
let blockedInfo :: Blocked ()
blockedInfo = Blocked Term -> Blocked ()
blockedOrMeta Blocked Term
r
case Term -> IntervalView
view (Blocked Term -> Term
forall t. Blocked t -> t
ignoreBlocking Blocked Term
r) of
IZero -> Term -> ReduceM (Blocked Term)
red (Term -> Elims -> Term
forall t. Apply t => t -> Elims -> t
applyE Term
x Elims
es)
IOne -> Term -> ReduceM (Blocked Term)
red (Term -> Elims -> Term
forall t. Apply t => t -> Elims -> t
applyE Term
y Elims
es)
_ -> (Blocked Term -> Blocked Term)
-> ReduceM (Blocked Term) -> ReduceM (Blocked Term)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Blocked Term -> Blocked () -> Blocked Term
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Blocked ()
blockedInfo) ((Term -> ReduceM (Blocked Term))
-> ReduceM (Blocked Term) -> Elims -> ReduceM (Blocked Term)
reduceIApply' Term -> ReduceM (Blocked Term)
red ReduceM (Blocked Term)
d Elims
es)
reduceIApply' red :: Term -> ReduceM (Blocked Term)
red d :: ReduceM (Blocked Term)
d (_ : es :: Elims
es) = (Term -> ReduceM (Blocked Term))
-> ReduceM (Blocked Term) -> Elims -> ReduceM (Blocked Term)
reduceIApply' Term -> ReduceM (Blocked Term)
red ReduceM (Blocked Term)
d Elims
es
reduceIApply' _ d :: ReduceM (Blocked Term)
d [] = ReduceM (Blocked Term)
d
instance Reduce DeBruijnPattern where
reduceB' :: DeBruijnPattern -> ReduceM (Blocked DeBruijnPattern)
reduceB' (DotP o :: PatternInfo
o v :: Term
v) = (Term -> DeBruijnPattern)
-> Blocked Term -> Blocked DeBruijnPattern
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (PatternInfo -> Term -> DeBruijnPattern
forall x. PatternInfo -> Term -> Pattern' x
DotP PatternInfo
o) (Blocked Term -> Blocked DeBruijnPattern)
-> ReduceM (Blocked Term) -> ReduceM (Blocked DeBruijnPattern)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term -> ReduceM (Blocked Term)
forall t. Reduce t => t -> ReduceM (Blocked t)
reduceB' Term
v
reduceB' p :: DeBruijnPattern
p = Blocked DeBruijnPattern -> ReduceM (Blocked DeBruijnPattern)
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocked DeBruijnPattern -> ReduceM (Blocked DeBruijnPattern))
-> Blocked DeBruijnPattern -> ReduceM (Blocked DeBruijnPattern)
forall a b. (a -> b) -> a -> b
$ DeBruijnPattern -> Blocked DeBruijnPattern
forall a. a -> Blocked a
notBlocked DeBruijnPattern
p
instance Reduce Term where
reduceB' :: Term -> ReduceM (Blocked Term)
reduceB' = {-# SCC "reduce'<Term>" #-} Term -> ReduceM (Blocked Term)
maybeFastReduceTerm
shouldTryFastReduce :: ReduceM Bool
shouldTryFastReduce :: ReduceM Bool
shouldTryFastReduce = (PragmaOptions -> Bool
optFastReduce (PragmaOptions -> Bool) -> ReduceM PragmaOptions -> ReduceM Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReduceM PragmaOptions
forall (m :: * -> *). HasOptions m => m PragmaOptions
pragmaOptions) ReduceM Bool -> ReduceM Bool -> ReduceM Bool
forall (m :: * -> *). Monad m => m Bool -> m Bool -> m Bool
`and2M` do
AllowedReductions
allowed <- (TCEnv -> AllowedReductions) -> ReduceM AllowedReductions
forall (m :: * -> *) a. MonadTCEnv m => (TCEnv -> a) -> m a
asksTC TCEnv -> AllowedReductions
envAllowedReductions
let optionalReductions :: AllowedReductions
optionalReductions = [AllowedReduction] -> AllowedReductions
forall a. SmallSetElement a => [a] -> SmallSet a
SmallSet.fromList [AllowedReduction
NonTerminatingReductions, AllowedReduction
UnconfirmedReductions]
requiredReductions :: AllowedReductions
requiredReductions = AllowedReductions
allReductions AllowedReductions -> AllowedReductions -> AllowedReductions
forall a.
SmallSetElement a =>
SmallSet a -> SmallSet a -> SmallSet a
SmallSet.\\ AllowedReductions
optionalReductions
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
$ (AllowedReductions
allowed AllowedReductions -> AllowedReductions -> AllowedReductions
forall a.
SmallSetElement a =>
SmallSet a -> SmallSet a -> SmallSet a
SmallSet.\\ AllowedReductions
optionalReductions) AllowedReductions -> AllowedReductions -> Bool
forall a. Eq a => a -> a -> Bool
== AllowedReductions
requiredReductions
maybeFastReduceTerm :: Term -> ReduceM (Blocked Term)
maybeFastReduceTerm :: Term -> ReduceM (Blocked Term)
maybeFastReduceTerm v :: Term
v = do
let tryFast :: Bool
tryFast = case Term
v of
Def{} -> Bool
True
Con{} -> Bool
True
MetaV{} -> Bool
True
_ -> Bool
False
if Bool -> Bool
not Bool
tryFast then Term -> ReduceM (Blocked Term)
slowReduceTerm Term
v
else
case Term
v of
MetaV x :: MetaId
x _ -> ReduceM Bool
-> ReduceM (Blocked Term)
-> ReduceM (Blocked Term)
-> ReduceM (Blocked Term)
forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifM (MetaId -> ReduceM Bool
forall (f :: * -> *).
(MonadFail f, ReadTCState f) =>
MetaId -> f Bool
isOpen MetaId
x) (Blocked Term -> ReduceM (Blocked Term)
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocked Term -> ReduceM (Blocked Term))
-> Blocked Term -> ReduceM (Blocked Term)
forall a b. (a -> b) -> a -> b
$ Term -> Blocked Term
forall a. a -> Blocked a
notBlocked Term
v) (Term -> ReduceM (Blocked Term)
maybeFast Term
v)
_ -> Term -> ReduceM (Blocked Term)
maybeFast Term
v
where
isOpen :: MetaId -> f Bool
isOpen x :: MetaId
x = MetaInstantiation -> Bool
isOpenMeta (MetaInstantiation -> Bool)
-> (MetaVariable -> MetaInstantiation) -> MetaVariable -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MetaVariable -> MetaInstantiation
mvInstantiation (MetaVariable -> Bool) -> f MetaVariable -> f Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MetaId -> f MetaVariable
forall (m :: * -> *).
(MonadFail m, ReadTCState m) =>
MetaId -> m MetaVariable
lookupMeta MetaId
x
maybeFast :: Term -> ReduceM (Blocked Term)
maybeFast v :: Term
v = ReduceM Bool
-> ReduceM (Blocked Term)
-> ReduceM (Blocked Term)
-> ReduceM (Blocked Term)
forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifM ReduceM Bool
shouldTryFastReduce (Term -> ReduceM (Blocked Term)
fastReduce Term
v) (Term -> ReduceM (Blocked Term)
slowReduceTerm Term
v)
slowReduceTerm :: Term -> ReduceM (Blocked Term)
slowReduceTerm :: Term -> ReduceM (Blocked Term)
slowReduceTerm v :: Term
v = do
Term
v <- Term -> ReduceM Term
forall t. Instantiate t => t -> ReduceM t
instantiate' Term
v
let done :: ReduceM (Blocked Term)
done = Blocked Term -> ReduceM (Blocked Term)
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocked Term -> ReduceM (Blocked Term))
-> Blocked Term -> ReduceM (Blocked Term)
forall a b. (a -> b) -> a -> b
$ Term -> Blocked Term
forall a. a -> Blocked a
notBlocked Term
v
iapp :: Elims -> ReduceM (Blocked Term)
iapp = ReduceM (Blocked Term) -> Elims -> ReduceM (Blocked Term)
reduceIApply ReduceM (Blocked Term)
done
case Term
v of
MetaV x :: MetaId
x es :: Elims
es -> Elims -> ReduceM (Blocked Term)
iapp Elims
es
Def f :: QName
f es :: Elims
es -> (ReduceM (Blocked Term) -> Elims -> ReduceM (Blocked Term))
-> Elims -> ReduceM (Blocked Term) -> ReduceM (Blocked Term)
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReduceM (Blocked Term) -> Elims -> ReduceM (Blocked Term)
reduceIApply Elims
es (ReduceM (Blocked Term) -> ReduceM (Blocked Term))
-> ReduceM (Blocked Term) -> ReduceM (Blocked Term)
forall a b. (a -> b) -> a -> b
$ Bool
-> (Term -> ReduceM (Blocked Term))
-> Term
-> QName
-> Elims
-> ReduceM (Blocked Term)
unfoldDefinitionE Bool
False Term -> ReduceM (Blocked Term)
forall t. Reduce t => t -> ReduceM (Blocked t)
reduceB' (QName -> Elims -> Term
Def QName
f []) QName
f Elims
es
Con c :: ConHead
c ci :: ConInfo
ci es :: Elims
es -> do
Blocked Term
v <- (ReduceM (Blocked Term) -> Elims -> ReduceM (Blocked Term))
-> Elims -> ReduceM (Blocked Term) -> ReduceM (Blocked Term)
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReduceM (Blocked Term) -> Elims -> ReduceM (Blocked Term)
reduceIApply Elims
es
(ReduceM (Blocked Term) -> ReduceM (Blocked Term))
-> ReduceM (Blocked Term) -> ReduceM (Blocked Term)
forall a b. (a -> b) -> a -> b
$ Bool
-> (Term -> ReduceM (Blocked Term))
-> Term
-> QName
-> Elims
-> ReduceM (Blocked Term)
unfoldDefinitionE Bool
False Term -> ReduceM (Blocked Term)
forall t. Reduce t => t -> ReduceM (Blocked t)
reduceB' (ConHead -> ConInfo -> Elims -> Term
Con ConHead
c ConInfo
ci []) (ConHead -> QName
conName ConHead
c) Elims
es
(Term -> ReduceM Term) -> Blocked Term -> ReduceM (Blocked Term)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Term -> ReduceM Term
reduceNat Blocked Term
v
Sort s :: Sort
s -> (Sort -> Term) -> Blocked Sort -> Blocked Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Sort -> Term
Sort (Blocked Sort -> Blocked Term)
-> ReduceM (Blocked Sort) -> ReduceM (Blocked Term)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sort -> ReduceM (Blocked Sort)
forall t. Reduce t => t -> ReduceM (Blocked t)
reduceB' Sort
s
Level l :: Level
l -> ReduceM Bool
-> ReduceM (Blocked Term)
-> ReduceM (Blocked Term)
-> ReduceM (Blocked Term)
forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifM (AllowedReduction -> AllowedReductions -> Bool
forall a. SmallSetElement a => a -> SmallSet a -> Bool
SmallSet.member AllowedReduction
LevelReductions (AllowedReductions -> Bool)
-> ReduceM AllowedReductions -> ReduceM Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (TCEnv -> AllowedReductions) -> ReduceM AllowedReductions
forall (m :: * -> *) a. MonadTCEnv m => (TCEnv -> a) -> m a
asksTC TCEnv -> AllowedReductions
envAllowedReductions)
((Level -> Term) -> Blocked Level -> Blocked Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Level -> Term
levelTm (Blocked Level -> Blocked Term)
-> ReduceM (Blocked Level) -> ReduceM (Blocked Term)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Level -> ReduceM (Blocked Level)
forall t. Reduce t => t -> ReduceM (Blocked t)
reduceB' Level
l)
ReduceM (Blocked Term)
done
Pi _ _ -> ReduceM (Blocked Term)
done
Lit _ -> ReduceM (Blocked Term)
done
Var _ es :: Elims
es -> Elims -> ReduceM (Blocked Term)
iapp Elims
es
Lam _ _ -> ReduceM (Blocked Term)
done
DontCare _ -> ReduceM (Blocked Term)
done
Dummy{} -> ReduceM (Blocked Term)
done
where
reduceNat :: Term -> ReduceM Term
reduceNat v :: Term
v@(Con c :: ConHead
c ci :: ConInfo
ci []) = do
Maybe Term
mz <- String -> ReduceM (Maybe Term)
forall (m :: * -> *). HasBuiltins m => String -> m (Maybe Term)
getBuiltin' String
builtinZero
case Term
v of
_ | Term -> Maybe Term
forall a. a -> Maybe a
Just Term
v Maybe Term -> Maybe Term -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe Term
mz -> 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
$ Literal -> Term
Lit (Literal -> Term) -> Literal -> Term
forall a b. (a -> b) -> a -> b
$ Range -> Integer -> Literal
LitNat (ConHead -> Range
forall t. HasRange t => t -> Range
getRange ConHead
c) 0
_ -> Term -> ReduceM Term
forall (m :: * -> *) a. Monad m => a -> m a
return Term
v
reduceNat v :: Term
v@(Con c :: ConHead
c ci :: ConInfo
ci [Apply a :: Arg Term
a]) | Arg Term -> Bool
forall a. LensHiding a => a -> Bool
visible Arg Term
a Bool -> Bool -> Bool
&& Arg Term -> Bool
forall a. LensRelevance a => a -> Bool
isRelevant Arg Term
a = do
Maybe Term
ms <- String -> ReduceM (Maybe Term)
forall (m :: * -> *). HasBuiltins m => String -> m (Maybe Term)
getBuiltin' String
builtinSuc
case Term
v of
_ | Term -> Maybe Term
forall a. a -> Maybe a
Just (ConHead -> ConInfo -> Elims -> Term
Con ConHead
c ConInfo
ci []) Maybe Term -> Maybe Term -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe Term
ms -> Term -> Term
inc (Term -> Term) -> ReduceM Term -> ReduceM Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term -> ReduceM Term
forall t. Reduce t => t -> ReduceM t
reduce' (Arg Term -> Term
forall e. Arg e -> e
unArg Arg Term
a)
_ -> Term -> ReduceM Term
forall (m :: * -> *) a. Monad m => a -> m a
return Term
v
where
inc :: Term -> Term
inc w :: Term
w = case Term
w of
Lit (LitNat r :: Range
r n :: Integer
n) -> Literal -> Term
Lit (Range -> Integer -> Literal
LitNat (ConHead -> Range -> Range
forall u t. (HasRange u, HasRange t) => u -> t -> Range
fuseRange ConHead
c Range
r) (Integer -> Literal) -> Integer -> Literal
forall a b. (a -> b) -> a -> b
$ Integer
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ 1)
_ -> ConHead -> ConInfo -> Elims -> Term
Con ConHead
c ConInfo
ci [Arg Term -> Elim
forall a. Arg a -> Elim' a
Apply (Arg Term -> Elim) -> Arg Term -> Elim
forall a b. (a -> b) -> a -> b
$ Term -> Arg Term
forall a. a -> Arg a
defaultArg Term
w]
reduceNat v :: Term
v = Term -> ReduceM Term
forall (m :: * -> *) a. Monad m => a -> m a
return Term
v
unfoldCorecursionE :: Elim -> ReduceM (Blocked Elim)
unfoldCorecursionE :: Elim -> ReduceM (Blocked Elim)
unfoldCorecursionE (Proj o :: ProjOrigin
o p :: QName
p) = Elim -> Blocked Elim
forall a. a -> Blocked a
notBlocked (Elim -> Blocked Elim) -> (QName -> Elim) -> QName -> Blocked Elim
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProjOrigin -> QName -> Elim
forall a. ProjOrigin -> QName -> Elim' a
Proj ProjOrigin
o (QName -> Blocked Elim) -> ReduceM QName -> ReduceM (Blocked Elim)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> QName -> ReduceM QName
forall (m :: * -> *). HasConstInfo m => QName -> m QName
getOriginalProjection QName
p
unfoldCorecursionE (Apply (Arg info :: ArgInfo
info v :: Term
v)) = (Term -> Elim) -> Blocked Term -> Blocked Elim
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Arg Term -> Elim
forall a. Arg a -> Elim' a
Apply (Arg Term -> Elim) -> (Term -> Arg Term) -> Term -> Elim
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ArgInfo -> Term -> Arg Term
forall e. ArgInfo -> e -> Arg e
Arg ArgInfo
info) (Blocked Term -> Blocked Elim)
-> ReduceM (Blocked Term) -> ReduceM (Blocked Elim)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
Term -> ReduceM (Blocked Term)
unfoldCorecursion Term
v
unfoldCorecursionE (IApply x :: Term
x y :: Term
y r :: Term
r) = do
[x :: Blocked Term
x,y :: Blocked Term
y,r :: Blocked Term
r] <- (Term -> ReduceM (Blocked Term))
-> [Term] -> ReduceM [Blocked Term]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Term -> ReduceM (Blocked Term)
unfoldCorecursion [Term
x,Term
y,Term
r]
Blocked Elim -> ReduceM (Blocked Elim)
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocked Elim -> ReduceM (Blocked Elim))
-> Blocked Elim -> ReduceM (Blocked Elim)
forall a b. (a -> b) -> a -> b
$ Term -> Term -> Term -> Elim
forall a. a -> a -> a -> Elim' a
IApply (Term -> Term -> Term -> Elim)
-> Blocked Term -> Blocked (Term -> Term -> Elim)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Blocked Term
x Blocked (Term -> Term -> Elim)
-> Blocked Term -> Blocked (Term -> Elim)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Blocked Term
y Blocked (Term -> Elim) -> Blocked Term -> Blocked Elim
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Blocked Term
r
unfoldCorecursion :: Term -> ReduceM (Blocked Term)
unfoldCorecursion :: Term -> ReduceM (Blocked Term)
unfoldCorecursion v :: Term
v = do
Term
v <- Term -> ReduceM Term
forall t. Instantiate t => t -> ReduceM t
instantiate' Term
v
case Term
v of
Def f :: QName
f es :: Elims
es -> Bool
-> (Term -> ReduceM (Blocked Term))
-> Term
-> QName
-> Elims
-> ReduceM (Blocked Term)
unfoldDefinitionE Bool
True Term -> ReduceM (Blocked Term)
unfoldCorecursion (QName -> Elims -> Term
Def QName
f []) QName
f Elims
es
_ -> Term -> ReduceM (Blocked Term)
slowReduceTerm Term
v
unfoldDefinition ::
Bool -> (Term -> ReduceM (Blocked Term)) ->
Term -> QName -> Args -> ReduceM (Blocked Term)
unfoldDefinition :: Bool
-> (Term -> ReduceM (Blocked Term))
-> Term
-> QName
-> [Arg Term]
-> ReduceM (Blocked Term)
unfoldDefinition unfoldDelayed :: Bool
unfoldDelayed keepGoing :: Term -> ReduceM (Blocked Term)
keepGoing v :: Term
v f :: QName
f args :: [Arg Term]
args =
Bool
-> (Term -> ReduceM (Blocked Term))
-> Term
-> QName
-> Elims
-> ReduceM (Blocked Term)
unfoldDefinitionE Bool
unfoldDelayed Term -> ReduceM (Blocked Term)
keepGoing Term
v QName
f ((Arg Term -> Elim) -> [Arg Term] -> Elims
forall a b. (a -> b) -> [a] -> [b]
map Arg Term -> Elim
forall a. Arg a -> Elim' a
Apply [Arg Term]
args)
unfoldDefinitionE ::
Bool -> (Term -> ReduceM (Blocked Term)) ->
Term -> QName -> Elims -> ReduceM (Blocked Term)
unfoldDefinitionE :: Bool
-> (Term -> ReduceM (Blocked Term))
-> Term
-> QName
-> Elims
-> ReduceM (Blocked Term)
unfoldDefinitionE unfoldDelayed :: Bool
unfoldDelayed keepGoing :: Term -> ReduceM (Blocked Term)
keepGoing v :: Term
v f :: QName
f es :: Elims
es = do
Reduced (Blocked Term) Term
r <- Bool
-> Term -> QName -> Elims -> ReduceM (Reduced (Blocked Term) Term)
unfoldDefinitionStep Bool
unfoldDelayed Term
v QName
f Elims
es
case Reduced (Blocked Term) Term
r of
NoReduction v :: Blocked Term
v -> Blocked Term -> ReduceM (Blocked Term)
forall (m :: * -> *) a. Monad m => a -> m a
return Blocked Term
v
YesReduction _ v :: Term
v -> Term -> ReduceM (Blocked Term)
keepGoing Term
v
unfoldDefinition' ::
Bool -> (Simplification -> Term -> ReduceM (Simplification, Blocked Term)) ->
Term -> QName -> Elims -> ReduceM (Simplification, Blocked Term)
unfoldDefinition' :: Bool
-> (Simplification
-> Term -> ReduceM (Simplification, Blocked Term))
-> Term
-> QName
-> Elims
-> ReduceM (Simplification, Blocked Term)
unfoldDefinition' unfoldDelayed :: Bool
unfoldDelayed keepGoing :: Simplification -> Term -> ReduceM (Simplification, Blocked Term)
keepGoing v0 :: Term
v0 f :: QName
f es :: Elims
es = do
Reduced (Blocked Term) Term
r <- Bool
-> Term -> QName -> Elims -> ReduceM (Reduced (Blocked Term) Term)
unfoldDefinitionStep Bool
unfoldDelayed Term
v0 QName
f Elims
es
case Reduced (Blocked Term) Term
r of
NoReduction v :: Blocked Term
v -> (Simplification, Blocked Term)
-> ReduceM (Simplification, Blocked Term)
forall (m :: * -> *) a. Monad m => a -> m a
return (Simplification
NoSimplification, Blocked Term
v)
YesReduction simp :: Simplification
simp v :: Term
v -> Simplification -> Term -> ReduceM (Simplification, Blocked Term)
keepGoing Simplification
simp Term
v
unfoldDefinitionStep :: Bool -> Term -> QName -> Elims -> ReduceM (Reduced (Blocked Term) Term)
unfoldDefinitionStep :: Bool
-> Term -> QName -> Elims -> ReduceM (Reduced (Blocked Term) Term)
unfoldDefinitionStep unfoldDelayed :: Bool
unfoldDelayed v0 :: Term
v0 f :: QName
f es :: Elims
es =
{-# SCC "reduceDef" #-} do
String
-> Int
-> TCM Doc
-> ReduceM (Reduced (Blocked Term) Term)
-> ReduceM (Reduced (Blocked Term) Term)
forall (m :: * -> *) a.
MonadDebug m =>
String -> Int -> TCM Doc -> m a -> m a
traceSDoc "tc.reduce" 90 ("unfoldDefinitionStep v0" TCM Doc -> TCM Doc -> TCM Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> Term -> TCM Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM Term
v0) (ReduceM (Reduced (Blocked Term) Term)
-> ReduceM (Reduced (Blocked Term) Term))
-> ReduceM (Reduced (Blocked Term) Term)
-> ReduceM (Reduced (Blocked Term) Term)
forall a b. (a -> b) -> a -> b
$ do
Definition
info <- QName -> ReduceM Definition
forall (m :: * -> *). HasConstInfo m => QName -> m Definition
getConstInfo QName
f
RewriteRules
rewr <- RewriteRules -> ReduceM RewriteRules
forall (m :: * -> *).
(Functor m, HasConstInfo m, HasOptions m, ReadTCState m,
MonadTCEnv m, MonadDebug m) =>
RewriteRules -> m RewriteRules
instantiateRewriteRules (RewriteRules -> ReduceM RewriteRules)
-> ReduceM RewriteRules -> ReduceM RewriteRules
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< QName -> ReduceM RewriteRules
forall (m :: * -> *). HasConstInfo m => QName -> m RewriteRules
getRewriteRulesFor QName
f
AllowedReductions
allowed <- (TCEnv -> AllowedReductions) -> ReduceM AllowedReductions
forall (m :: * -> *) a. MonadTCEnv m => (TCEnv -> a) -> m a
asksTC TCEnv -> AllowedReductions
envAllowedReductions
Bool
prp <- Type -> ReduceM Bool
forall a (m :: * -> *).
(LensSort a, PrettyTCM a, MonadReduce m, MonadDebug m) =>
a -> m Bool
isPropM (Type -> ReduceM Bool) -> Type -> ReduceM Bool
forall a b. (a -> b) -> a -> b
$ Definition -> Type
defType Definition
info
let def :: Defn
def = Definition -> Defn
theDef Definition
info
v :: Term
v = Term
v0 Term -> Elims -> Term
forall t. Apply t => t -> Elims -> t
`applyE` Elims
es
dontUnfold :: Bool
dontUnfold =
(Definition -> Bool
defNonterminating Definition
info Bool -> Bool -> Bool
&& AllowedReduction -> AllowedReductions -> Bool
forall a. SmallSetElement a => a -> SmallSet a -> Bool
SmallSet.notMember AllowedReduction
NonTerminatingReductions AllowedReductions
allowed)
Bool -> Bool -> Bool
|| (Definition -> Bool
defTerminationUnconfirmed Definition
info Bool -> Bool -> Bool
&& AllowedReduction -> AllowedReductions -> Bool
forall a. SmallSetElement a => a -> SmallSet a -> Bool
SmallSet.notMember AllowedReduction
UnconfirmedReductions AllowedReductions
allowed)
Bool -> Bool -> Bool
|| (Definition -> Delayed
defDelayed Definition
info Delayed -> Delayed -> Bool
forall a. Eq a => a -> a -> Bool
== Delayed
Delayed Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
unfoldDelayed)
Bool -> Bool -> Bool
|| Bool
prp Bool -> Bool -> Bool
|| ArgInfo -> Bool
forall a. LensRelevance a => a -> Bool
isIrrelevant (Definition -> ArgInfo
defArgInfo Definition
info)
copatterns :: Bool
copatterns = Definition -> Bool
defCopatternLHS Definition
info
case Defn
def of
Constructor{conSrcCon :: Defn -> ConHead
conSrcCon = ConHead
c} ->
Blocked Term -> ReduceM (Reduced (Blocked Term) Term)
forall no yes. no -> ReduceM (Reduced no yes)
noReduction (Blocked Term -> ReduceM (Reduced (Blocked Term) Term))
-> Blocked Term -> ReduceM (Reduced (Blocked Term) Term)
forall a b. (a -> b) -> a -> b
$ Term -> Blocked Term
forall a. a -> Blocked a
notBlocked (Term -> Blocked Term) -> Term -> Blocked Term
forall a b. (a -> b) -> a -> b
$ ConHead -> ConInfo -> Elims -> Term
Con (ConHead
c ConHead -> QName -> ConHead
forall t u. (SetRange t, HasRange u) => t -> u -> t
`withRangeOf` QName
f) ConInfo
ConOSystem [] Term -> Elims -> Term
forall t. Apply t => t -> Elims -> t
`applyE` Elims
es
Primitive{primAbstr :: Defn -> IsAbstract
primAbstr = IsAbstract
ConcreteDef, primName :: Defn -> String
primName = String
x, primClauses :: Defn -> [Clause]
primClauses = [Clause]
cls} -> do
PrimFun
pf <- PrimFun -> Maybe PrimFun -> PrimFun
forall a. a -> Maybe a -> a
fromMaybe PrimFun
forall a. HasCallStack => a
__IMPOSSIBLE__ (Maybe PrimFun -> PrimFun)
-> ReduceM (Maybe PrimFun) -> ReduceM PrimFun
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> ReduceM (Maybe PrimFun)
forall (m :: * -> *). HasBuiltins m => String -> m (Maybe PrimFun)
getPrimitive' String
x
if AllowedReduction
FunctionReductions AllowedReduction -> AllowedReductions -> Bool
forall a. SmallSetElement a => a -> SmallSet a -> Bool
`SmallSet.member` AllowedReductions
allowed
then String
-> Term
-> QName
-> Elims
-> PrimFun
-> Bool
-> [Clause]
-> Maybe CompiledClauses
-> RewriteRules
-> ReduceM (Reduced (Blocked Term) Term)
reducePrimitive String
x Term
v0 QName
f Elims
es PrimFun
pf Bool
dontUnfold
[Clause]
cls (Definition -> Maybe CompiledClauses
defCompiled Definition
info) RewriteRules
rewr
else Blocked Term -> ReduceM (Reduced (Blocked Term) Term)
forall no yes. no -> ReduceM (Reduced no yes)
noReduction (Blocked Term -> ReduceM (Reduced (Blocked Term) Term))
-> Blocked Term -> ReduceM (Reduced (Blocked Term) Term)
forall a b. (a -> b) -> a -> b
$ Term -> Blocked Term
forall a. a -> Blocked a
notBlocked Term
v
_ -> do
if (AllowedReduction
RecursiveReductions AllowedReduction -> AllowedReductions -> Bool
forall a. SmallSetElement a => a -> SmallSet a -> Bool
`SmallSet.member` AllowedReductions
allowed) Bool -> Bool -> Bool
||
(Maybe Projection -> Bool
forall a. Maybe a -> Bool
isJust (Defn -> Maybe Projection
isProjection_ Defn
def) Bool -> Bool -> Bool
&& AllowedReduction
ProjectionReductions AllowedReduction -> AllowedReductions -> Bool
forall a. SmallSetElement a => a -> SmallSet a -> Bool
`SmallSet.member` AllowedReductions
allowed) Bool -> Bool -> Bool
||
(Defn -> Bool
isInlineFun Defn
def Bool -> Bool -> Bool
&& AllowedReduction
InlineReductions AllowedReduction -> AllowedReductions -> Bool
forall a. SmallSetElement a => a -> SmallSet a -> Bool
`SmallSet.member` AllowedReductions
allowed) Bool -> Bool -> Bool
||
(Defn -> Bool
definitelyNonRecursive_ Defn
def Bool -> Bool -> Bool
&& Bool
copatterns Bool -> Bool -> Bool
&& AllowedReduction
CopatternReductions AllowedReduction -> AllowedReductions -> Bool
forall a. SmallSetElement a => a -> SmallSet a -> Bool
`SmallSet.member` AllowedReductions
allowed) Bool -> Bool -> Bool
||
(Defn -> Bool
definitelyNonRecursive_ Defn
def Bool -> Bool -> Bool
&& AllowedReduction
FunctionReductions AllowedReduction -> AllowedReductions -> Bool
forall a. SmallSetElement a => a -> SmallSet a -> Bool
`SmallSet.member` AllowedReductions
allowed)
then
Term
-> QName
-> [MaybeReduced Elim]
-> Bool
-> [Clause]
-> Maybe CompiledClauses
-> RewriteRules
-> ReduceM (Reduced (Blocked Term) Term)
reduceNormalE Term
v0 QName
f ((Elim -> MaybeReduced Elim) -> Elims -> [MaybeReduced Elim]
forall a b. (a -> b) -> [a] -> [b]
map Elim -> MaybeReduced Elim
forall a. a -> MaybeReduced a
notReduced Elims
es) Bool
dontUnfold
(Definition -> [Clause]
defClauses Definition
info) (Definition -> Maybe CompiledClauses
defCompiled Definition
info) RewriteRules
rewr
else Blocked Term -> ReduceM (Reduced (Blocked Term) Term)
forall no yes. no -> ReduceM (Reduced no yes)
noReduction (Blocked Term -> ReduceM (Reduced (Blocked Term) Term))
-> Blocked Term -> ReduceM (Reduced (Blocked Term) Term)
forall a b. (a -> b) -> a -> b
$ Term -> Blocked Term
forall a. a -> Blocked a
notBlocked Term
v
where
noReduction :: no -> ReduceM (Reduced no yes)
noReduction = Reduced no yes -> ReduceM (Reduced no yes)
forall (m :: * -> *) a. Monad m => a -> m a
return (Reduced no yes -> ReduceM (Reduced no yes))
-> (no -> Reduced no yes) -> no -> ReduceM (Reduced no yes)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. no -> Reduced no yes
forall no yes. no -> Reduced no yes
NoReduction
yesReduction :: Simplification -> yes -> m (Reduced no yes)
yesReduction s :: Simplification
s = Reduced no yes -> m (Reduced no yes)
forall (m :: * -> *) a. Monad m => a -> m a
return (Reduced no yes -> m (Reduced no yes))
-> (yes -> Reduced no yes) -> yes -> m (Reduced no yes)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Simplification -> yes -> Reduced no yes
forall no yes. Simplification -> yes -> Reduced no yes
YesReduction Simplification
s
reducePrimitive :: String
-> Term
-> QName
-> Elims
-> PrimFun
-> Bool
-> [Clause]
-> Maybe CompiledClauses
-> RewriteRules
-> ReduceM (Reduced (Blocked Term) Term)
reducePrimitive x :: String
x v0 :: Term
v0 f :: QName
f es :: Elims
es pf :: PrimFun
pf dontUnfold :: Bool
dontUnfold cls :: [Clause]
cls mcc :: Maybe CompiledClauses
mcc rewr :: RewriteRules
rewr
| Elims -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Elims
es Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
ar
= Blocked Term -> ReduceM (Reduced (Blocked Term) Term)
forall no yes. no -> ReduceM (Reduced no yes)
noReduction (Blocked Term -> ReduceM (Reduced (Blocked Term) Term))
-> Blocked Term -> ReduceM (Reduced (Blocked Term) Term)
forall a b. (a -> b) -> a -> b
$ NotBlocked -> Term -> Blocked Term
forall t. NotBlocked -> t -> Blocked t
NotBlocked NotBlocked
Underapplied (Term -> Blocked Term) -> Term -> Blocked Term
forall a b. (a -> b) -> a -> b
$ Term
v0 Term -> Elims -> Term
forall t. Apply t => t -> Elims -> t
`applyE` Elims
es
| Bool
otherwise = {-# SCC "reducePrimitive" #-} do
let (es1 :: Elims
es1,es2 :: Elims
es2) = Int -> Elims -> (Elims, Elims)
forall a. Int -> [a] -> ([a], [a])
splitAt Int
ar Elims
es
args1 :: [Arg Term]
args1 = [Arg Term] -> Maybe [Arg Term] -> [Arg Term]
forall a. a -> Maybe a -> a
fromMaybe [Arg Term]
forall a. HasCallStack => a
__IMPOSSIBLE__ (Maybe [Arg Term] -> [Arg Term]) -> Maybe [Arg Term] -> [Arg Term]
forall a b. (a -> b) -> a -> b
$ (Elim -> Maybe (Arg Term)) -> Elims -> Maybe [Arg Term]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Elim -> Maybe (Arg Term)
forall a. Elim' a -> Maybe (Arg a)
isApplyElim Elims
es1
Reduced MaybeReducedArgs Term
r <- PrimFun
-> [Arg Term] -> Int -> ReduceM (Reduced MaybeReducedArgs Term)
primFunImplementation PrimFun
pf [Arg Term]
args1 (Elims -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Elims
es2)
case Reduced MaybeReducedArgs Term
r of
NoReduction args1' :: MaybeReducedArgs
args1' -> do
let es1' :: [MaybeReduced Elim]
es1' = (MaybeReduced (Arg Term) -> MaybeReduced Elim)
-> MaybeReducedArgs -> [MaybeReduced Elim]
forall a b. (a -> b) -> [a] -> [b]
map ((Arg Term -> Elim) -> MaybeReduced (Arg Term) -> MaybeReduced Elim
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Arg Term -> Elim
forall a. Arg a -> Elim' a
Apply) MaybeReducedArgs
args1'
if [Clause] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Clause]
cls Bool -> Bool -> Bool
&& RewriteRules -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null RewriteRules
rewr then do
Blocked Term -> ReduceM (Reduced (Blocked Term) Term)
forall no yes. no -> ReduceM (Reduced no yes)
noReduction (Blocked Term -> ReduceM (Reduced (Blocked Term) Term))
-> Blocked Term -> ReduceM (Reduced (Blocked Term) Term)
forall a b. (a -> b) -> a -> b
$ Term -> Elims -> Term
forall t. Apply t => t -> Elims -> t
applyE (QName -> Elims -> Term
Def QName
f []) (Elims -> Term) -> Blocked Elims -> Blocked Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
(Blocked Elim -> Blocked Elim) -> [Blocked Elim] -> Blocked Elims
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Blocked Elim -> Blocked Elim
forall a. a -> a
id ([Blocked Elim] -> Blocked Elims)
-> [Blocked Elim] -> Blocked Elims
forall a b. (a -> b) -> a -> b
$
(MaybeReduced Elim -> Blocked Elim)
-> [MaybeReduced Elim] -> [Blocked Elim]
forall a b. (a -> b) -> [a] -> [b]
map MaybeReduced Elim -> Blocked Elim
forall a. MaybeReduced a -> Blocked a
mredToBlocked [MaybeReduced Elim]
es1' [Blocked Elim] -> [Blocked Elim] -> [Blocked Elim]
forall a. [a] -> [a] -> [a]
++ (Elim -> Blocked Elim) -> Elims -> [Blocked Elim]
forall a b. (a -> b) -> [a] -> [b]
map Elim -> Blocked Elim
forall a. a -> Blocked a
notBlocked Elims
es2
else
Term
-> QName
-> [MaybeReduced Elim]
-> Bool
-> [Clause]
-> Maybe CompiledClauses
-> RewriteRules
-> ReduceM (Reduced (Blocked Term) Term)
reduceNormalE Term
v0 QName
f ([MaybeReduced Elim]
es1' [MaybeReduced Elim] -> [MaybeReduced Elim] -> [MaybeReduced Elim]
forall a. [a] -> [a] -> [a]
++ (Elim -> MaybeReduced Elim) -> Elims -> [MaybeReduced Elim]
forall a b. (a -> b) -> [a] -> [b]
map Elim -> MaybeReduced Elim
forall a. a -> MaybeReduced a
notReduced Elims
es2) Bool
dontUnfold [Clause]
cls Maybe CompiledClauses
mcc RewriteRules
rewr
YesReduction simpl :: Simplification
simpl v :: Term
v -> Simplification -> Term -> ReduceM (Reduced (Blocked Term) Term)
forall (m :: * -> *) yes no.
Monad m =>
Simplification -> yes -> m (Reduced no yes)
yesReduction Simplification
simpl (Term -> ReduceM (Reduced (Blocked Term) Term))
-> Term -> ReduceM (Reduced (Blocked Term) Term)
forall a b. (a -> b) -> a -> b
$ Term
v Term -> Elims -> Term
forall t. Apply t => t -> Elims -> t
`applyE` Elims
es2
where
ar :: Int
ar = PrimFun -> Int
primFunArity PrimFun
pf
mredToBlocked :: MaybeReduced a -> Blocked a
mredToBlocked :: MaybeReduced a -> Blocked a
mredToBlocked (MaybeRed NotReduced x :: a
x) = a -> Blocked a
forall a. a -> Blocked a
notBlocked a
x
mredToBlocked (MaybeRed (Reduced b :: Blocked ()
b) x :: a
x) = a
x a -> Blocked () -> Blocked a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Blocked ()
b
reduceNormalE :: Term -> QName -> [MaybeReduced Elim] -> Bool -> [Clause] -> Maybe CompiledClauses -> RewriteRules -> ReduceM (Reduced (Blocked Term) Term)
reduceNormalE :: Term
-> QName
-> [MaybeReduced Elim]
-> Bool
-> [Clause]
-> Maybe CompiledClauses
-> RewriteRules
-> ReduceM (Reduced (Blocked Term) Term)
reduceNormalE v0 :: Term
v0 f :: QName
f es :: [MaybeReduced Elim]
es dontUnfold :: Bool
dontUnfold def :: [Clause]
def mcc :: Maybe CompiledClauses
mcc rewr :: RewriteRules
rewr = {-# SCC "reduceNormal" #-} do
String
-> Int
-> TCM Doc
-> ReduceM (Reduced (Blocked Term) Term)
-> ReduceM (Reduced (Blocked Term) Term)
forall (m :: * -> *) a.
MonadDebug m =>
String -> Int -> TCM Doc -> m a -> m a
traceSDoc "tc.reduce" 90 ("reduceNormalE v0 =" TCM Doc -> TCM Doc -> TCM Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> Term -> TCM Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM Term
v0) (ReduceM (Reduced (Blocked Term) Term)
-> ReduceM (Reduced (Blocked Term) Term))
-> ReduceM (Reduced (Blocked Term) Term)
-> ReduceM (Reduced (Blocked Term) Term)
forall a b. (a -> b) -> a -> b
$ do
case ([Clause]
def,RewriteRules
rewr) of
_ | Bool
dontUnfold -> String
-> Int
-> String
-> ReduceM (Reduced (Blocked Term) Term)
-> ReduceM (Reduced (Blocked Term) Term)
forall (m :: * -> *) a.
MonadDebug m =>
String -> Int -> String -> m a -> m a
traceSLn "tc.reduce" 90 "reduceNormalE: don't unfold (non-terminating or delayed)" (ReduceM (Reduced (Blocked Term) Term)
-> ReduceM (Reduced (Blocked Term) Term))
-> ReduceM (Reduced (Blocked Term) Term)
-> ReduceM (Reduced (Blocked Term) Term)
forall a b. (a -> b) -> a -> b
$
ReduceM (Reduced (Blocked Term) Term)
defaultResult
([],[]) -> String
-> Int
-> String
-> ReduceM (Reduced (Blocked Term) Term)
-> ReduceM (Reduced (Blocked Term) Term)
forall (m :: * -> *) a.
MonadDebug m =>
String -> Int -> String -> m a -> m a
traceSLn "tc.reduce" 90 "reduceNormalE: no clauses or rewrite rules" (ReduceM (Reduced (Blocked Term) Term)
-> ReduceM (Reduced (Blocked Term) Term))
-> ReduceM (Reduced (Blocked Term) Term)
-> ReduceM (Reduced (Blocked Term) Term)
forall a b. (a -> b) -> a -> b
$ do
Blocked ()
blk <- Definition -> Blocked ()
defBlocked (Definition -> Blocked ())
-> ReduceM Definition -> ReduceM (Blocked ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> QName -> ReduceM Definition
forall (m :: * -> *). HasConstInfo m => QName -> m Definition
getConstInfo QName
f
Blocked Term -> ReduceM (Reduced (Blocked Term) Term)
forall no yes. no -> ReduceM (Reduced no yes)
noReduction (Blocked Term -> ReduceM (Reduced (Blocked Term) Term))
-> Blocked Term -> ReduceM (Reduced (Blocked Term) Term)
forall a b. (a -> b) -> a -> b
$ Blocked ()
blk Blocked () -> Term -> Blocked Term
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Term
vfull
(cls :: [Clause]
cls,rewr :: RewriteRules
rewr) -> do
Reduced (Blocked Term) Term
ev <- QName
-> Term
-> [Clause]
-> Maybe CompiledClauses
-> RewriteRules
-> [MaybeReduced Elim]
-> ReduceM (Reduced (Blocked Term) Term)
appDefE_ QName
f Term
v0 [Clause]
cls Maybe CompiledClauses
mcc RewriteRules
rewr [MaybeReduced Elim]
es
Reduced (Blocked Term) Term -> ReduceM ()
debugReduce Reduced (Blocked Term) Term
ev
Reduced (Blocked Term) Term
-> ReduceM (Reduced (Blocked Term) Term)
forall (m :: * -> *) a. Monad m => a -> m a
return Reduced (Blocked Term) Term
ev
where
defaultResult :: ReduceM (Reduced (Blocked Term) Term)
defaultResult = Blocked Term -> ReduceM (Reduced (Blocked Term) Term)
forall no yes. no -> ReduceM (Reduced no yes)
noReduction (Blocked Term -> ReduceM (Reduced (Blocked Term) Term))
-> Blocked Term -> ReduceM (Reduced (Blocked Term) Term)
forall a b. (a -> b) -> a -> b
$ NotBlocked -> Term -> Blocked Term
forall t. NotBlocked -> t -> Blocked t
NotBlocked NotBlocked
ReallyNotBlocked Term
vfull
vfull :: Term
vfull = Term
v0 Term -> Elims -> Term
forall t. Apply t => t -> Elims -> t
`applyE` (MaybeReduced Elim -> Elim) -> [MaybeReduced Elim] -> Elims
forall a b. (a -> b) -> [a] -> [b]
map MaybeReduced Elim -> Elim
forall a. MaybeReduced a -> a
ignoreReduced [MaybeReduced Elim]
es
debugReduce :: Reduced (Blocked Term) Term -> ReduceM ()
debugReduce ev :: Reduced (Blocked Term) Term
ev = String -> Int -> ReduceM () -> ReduceM ()
forall (m :: * -> *). MonadDebug m => String -> Int -> m () -> m ()
verboseS "tc.reduce" 90 (ReduceM () -> ReduceM ()) -> ReduceM () -> ReduceM ()
forall a b. (a -> b) -> a -> b
$ do
case Reduced (Blocked Term) Term
ev of
NoReduction v :: Blocked Term
v -> do
String -> Int -> TCM Doc -> ReduceM ()
forall (m :: * -> *).
MonadDebug m =>
String -> Int -> TCM Doc -> m ()
reportSDoc "tc.reduce" 90 (TCM Doc -> ReduceM ()) -> TCM Doc -> ReduceM ()
forall a b. (a -> b) -> a -> b
$ [TCM Doc] -> TCM Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
vcat
[ "*** tried to reduce " TCM Doc -> TCM Doc -> TCM Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> QName -> TCM Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM QName
f
, " es = " TCM Doc -> TCM Doc -> TCM Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> [TCM Doc] -> TCM Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
sep ((MaybeReduced Elim -> TCM Doc) -> [MaybeReduced Elim] -> [TCM Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Elim -> TCM Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM (Elim -> TCM Doc)
-> (MaybeReduced Elim -> Elim) -> MaybeReduced Elim -> TCM Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MaybeReduced Elim -> Elim
forall a. MaybeReduced a -> a
ignoreReduced) [MaybeReduced Elim]
es)
, " stuck on" TCM Doc -> TCM Doc -> TCM Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> Term -> TCM Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM (Blocked Term -> Term
forall t. Blocked t -> t
ignoreBlocking Blocked Term
v)
]
YesReduction _simpl :: Simplification
_simpl v :: Term
v -> do
String -> Int -> TCM Doc -> ReduceM ()
forall (m :: * -> *).
MonadDebug m =>
String -> Int -> TCM Doc -> m ()
reportSDoc "tc.reduce" 90 (TCM Doc -> ReduceM ()) -> TCM Doc -> ReduceM ()
forall a b. (a -> b) -> a -> b
$ "*** reduced definition: " TCM Doc -> TCM Doc -> TCM Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> QName -> TCM Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM QName
f
String -> Int -> TCM Doc -> ReduceM ()
forall (m :: * -> *).
MonadDebug m =>
String -> Int -> TCM Doc -> m ()
reportSDoc "tc.reduce" 95 (TCM Doc -> ReduceM ()) -> TCM Doc -> ReduceM ()
forall a b. (a -> b) -> a -> b
$ " result" TCM Doc -> TCM Doc -> TCM Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> Term -> TCM Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM Term
v
String -> Int -> TCM Doc -> ReduceM ()
forall (m :: * -> *).
MonadDebug m =>
String -> Int -> TCM Doc -> m ()
reportSDoc "tc.reduce" 100 (TCM Doc -> ReduceM ()) -> TCM Doc -> ReduceM ()
forall a b. (a -> b) -> a -> b
$ " raw " TCM Doc -> TCM Doc -> TCM Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> String -> TCM Doc
forall (m :: * -> *). Monad m => String -> m Doc
text (Term -> String
forall a. Show a => a -> String
show Term
v)
reduceDefCopy :: forall m. (MonadReduce m, HasConstInfo m, HasOptions m,
ReadTCState m, MonadTCEnv m, MonadDebug m)
=> QName -> Elims -> m (Reduced () Term)
reduceDefCopy :: QName -> Elims -> m (Reduced () Term)
reduceDefCopy f :: QName
f es :: Elims
es = do
Definition
info <- QName -> m Definition
forall (m :: * -> *). HasConstInfo m => QName -> m Definition
getConstInfo QName
f
RewriteRules
rewr <- RewriteRules -> m RewriteRules
forall (m :: * -> *).
(Functor m, HasConstInfo m, HasOptions m, ReadTCState m,
MonadTCEnv m, MonadDebug m) =>
RewriteRules -> m RewriteRules
instantiateRewriteRules (RewriteRules -> m RewriteRules)
-> m RewriteRules -> m RewriteRules
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< QName -> m RewriteRules
forall (m :: * -> *). HasConstInfo m => QName -> m RewriteRules
getRewriteRulesFor QName
f
if (Definition -> Bool
defCopy Definition
info) then Definition -> RewriteRules -> QName -> Elims -> m (Reduced () Term)
reduceDef_ Definition
info RewriteRules
rewr QName
f Elims
es else Reduced () Term -> m (Reduced () Term)
forall (m :: * -> *) a. Monad m => a -> m a
return (Reduced () Term -> m (Reduced () Term))
-> Reduced () Term -> m (Reduced () Term)
forall a b. (a -> b) -> a -> b
$ () -> Reduced () Term
forall no yes. no -> Reduced no yes
NoReduction ()
where
reduceDef_ :: Definition -> RewriteRules -> QName -> Elims -> m (Reduced () Term)
reduceDef_ :: Definition -> RewriteRules -> QName -> Elims -> m (Reduced () Term)
reduceDef_ info :: Definition
info rewr :: RewriteRules
rewr f :: QName
f es :: Elims
es = do
let v0 :: Term
v0 = QName -> Elims -> Term
Def QName
f []
cls :: [Clause]
cls = (Definition -> [Clause]
defClauses Definition
info)
mcc :: Maybe CompiledClauses
mcc = (Definition -> Maybe CompiledClauses
defCompiled Definition
info)
if (Definition -> Delayed
defDelayed Definition
info Delayed -> Delayed -> Bool
forall a. Eq a => a -> a -> Bool
== Delayed
Delayed) Bool -> Bool -> Bool
|| (Definition -> Bool
defNonterminating Definition
info)
then Reduced () Term -> m (Reduced () Term)
forall (m :: * -> *) a. Monad m => a -> m a
return (Reduced () Term -> m (Reduced () Term))
-> Reduced () Term -> m (Reduced () Term)
forall a b. (a -> b) -> a -> b
$ () -> Reduced () Term
forall no yes. no -> Reduced no yes
NoReduction ()
else do
Reduced (Blocked Term) Term
ev <- ReduceM (Reduced (Blocked Term) Term)
-> m (Reduced (Blocked Term) Term)
forall (m :: * -> *) a. MonadReduce m => ReduceM a -> m a
liftReduce (ReduceM (Reduced (Blocked Term) Term)
-> m (Reduced (Blocked Term) Term))
-> ReduceM (Reduced (Blocked Term) Term)
-> m (Reduced (Blocked Term) Term)
forall a b. (a -> b) -> a -> b
$ QName
-> Term
-> [Clause]
-> Maybe CompiledClauses
-> RewriteRules
-> [MaybeReduced Elim]
-> ReduceM (Reduced (Blocked Term) Term)
appDefE_ QName
f Term
v0 [Clause]
cls Maybe CompiledClauses
mcc RewriteRules
rewr ([MaybeReduced Elim] -> ReduceM (Reduced (Blocked Term) Term))
-> [MaybeReduced Elim] -> ReduceM (Reduced (Blocked Term) Term)
forall a b. (a -> b) -> a -> b
$ (Elim -> MaybeReduced Elim) -> Elims -> [MaybeReduced Elim]
forall a b. (a -> b) -> [a] -> [b]
map Elim -> MaybeReduced Elim
forall a. a -> MaybeReduced a
notReduced Elims
es
case Reduced (Blocked Term) Term
ev of
YesReduction simpl :: Simplification
simpl t :: Term
t -> Reduced () Term -> m (Reduced () Term)
forall (m :: * -> *) a. Monad m => a -> m a
return (Reduced () Term -> m (Reduced () Term))
-> Reduced () Term -> m (Reduced () Term)
forall a b. (a -> b) -> a -> b
$ Simplification -> Term -> Reduced () Term
forall no yes. Simplification -> yes -> Reduced no yes
YesReduction Simplification
simpl Term
t
NoReduction{} -> Reduced () Term -> m (Reduced () Term)
forall (m :: * -> *) a. Monad m => a -> m a
return (Reduced () Term -> m (Reduced () Term))
-> Reduced () Term -> m (Reduced () Term)
forall a b. (a -> b) -> a -> b
$ () -> Reduced () Term
forall no yes. no -> Reduced no yes
NoReduction ()
reduceHead :: (HasBuiltins m, HasConstInfo m, MonadReduce m, MonadDebug m)
=> Term -> m (Blocked Term)
reduceHead :: Term -> m (Blocked Term)
reduceHead v :: Term
v = do
Term
v <- Term -> m Term
forall (m :: * -> *). HasBuiltins m => Term -> m Term
constructorForm Term
v
String -> Int -> TCM Doc -> m (Blocked Term) -> m (Blocked Term)
forall (m :: * -> *) a.
MonadDebug m =>
String -> Int -> TCM Doc -> m a -> m a
traceSDoc "tc.inj.reduce" 30 (TCM Doc -> TCM Doc
forall (m :: * -> *) a. MonadTCEnv m => m a -> m a
ignoreAbstractMode (TCM Doc -> TCM Doc) -> TCM Doc -> TCM Doc
forall a b. (a -> b) -> a -> b
$ "reduceHead" TCM Doc -> TCM Doc -> TCM Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> Term -> TCM Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM Term
v) (m (Blocked Term) -> m (Blocked Term))
-> m (Blocked Term) -> m (Blocked Term)
forall a b. (a -> b) -> a -> b
$ do
case Term
v of
Def f :: QName
f es :: Elims
es -> do
AbstractMode
abstractMode <- TCEnv -> AbstractMode
envAbstractMode (TCEnv -> AbstractMode) -> m TCEnv -> m AbstractMode
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m TCEnv
forall (m :: * -> *). MonadTCEnv m => m TCEnv
askTC
Bool
isAbstract <- QName -> m Bool
forall (m :: * -> *). MonadTCEnv m => QName -> m Bool
treatAbstractly QName
f
String -> Int -> String -> m (Blocked Term) -> m (Blocked Term)
forall (m :: * -> *) a.
MonadDebug m =>
String -> Int -> String -> m a -> m a
traceSLn "tc.inj.reduce" 50 (
"reduceHead: we are in " String -> String -> String
forall a. [a] -> [a] -> [a]
++ AbstractMode -> String
forall a. Show a => a -> String
show AbstractMode
abstractModeString -> String -> String
forall a. [a] -> [a] -> [a]
++ "; " String -> String -> String
forall a. [a] -> [a] -> [a]
++ QName -> String
forall a. Show a => a -> String
show QName
f String -> String -> String
forall a. [a] -> [a] -> [a]
++
" is treated " String -> String -> String
forall a. [a] -> [a] -> [a]
++ if Bool
isAbstract then "abstractly" else "concretely"
) (m (Blocked Term) -> m (Blocked Term))
-> m (Blocked Term) -> m (Blocked Term)
forall a b. (a -> b) -> a -> b
$ do
let v0 :: Term
v0 = QName -> Elims -> Term
Def QName
f []
red :: m (Blocked Term)
red = ReduceM (Blocked Term) -> m (Blocked Term)
forall (m :: * -> *) a. MonadReduce m => ReduceM a -> m a
liftReduce (ReduceM (Blocked Term) -> m (Blocked Term))
-> ReduceM (Blocked Term) -> m (Blocked Term)
forall a b. (a -> b) -> a -> b
$ Bool
-> (Term -> ReduceM (Blocked Term))
-> Term
-> QName
-> Elims
-> ReduceM (Blocked Term)
unfoldDefinitionE Bool
False Term -> ReduceM (Blocked Term)
forall (m :: * -> *).
(HasBuiltins m, HasConstInfo m, MonadReduce m, MonadDebug m) =>
Term -> m (Blocked Term)
reduceHead Term
v0 QName
f Elims
es
Defn
def <- Definition -> Defn
theDef (Definition -> Defn) -> m Definition -> m Defn
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> QName -> m Definition
forall (m :: * -> *). HasConstInfo m => QName -> m Definition
getConstInfo QName
f
case Defn
def of
Function{ funClauses :: Defn -> [Clause]
funClauses = [ _ ], funDelayed :: Defn -> Delayed
funDelayed = Delayed
NotDelayed, funTerminates :: Defn -> Maybe Bool
funTerminates = Just True } -> do
String -> Int -> String -> m (Blocked Term) -> m (Blocked Term)
forall (m :: * -> *) a.
MonadDebug m =>
String -> Int -> String -> m a -> m a
traceSLn "tc.inj.reduce" 50 ("reduceHead: head " String -> String -> String
forall a. [a] -> [a] -> [a]
++ QName -> String
forall a. Show a => a -> String
show QName
f String -> String -> String
forall a. [a] -> [a] -> [a]
++ " is Function") (m (Blocked Term) -> m (Blocked Term))
-> m (Blocked Term) -> m (Blocked Term)
forall a b. (a -> b) -> a -> b
$ do
m (Blocked Term)
red
Datatype{ dataClause :: Defn -> Maybe Clause
dataClause = Just _ } -> m (Blocked Term)
red
Record{ recClause :: Defn -> Maybe Clause
recClause = Just _ } -> m (Blocked Term)
red
_ -> Blocked Term -> m (Blocked Term)
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocked Term -> m (Blocked Term))
-> Blocked Term -> m (Blocked Term)
forall a b. (a -> b) -> a -> b
$ Term -> Blocked Term
forall a. a -> Blocked a
notBlocked Term
v
_ -> Blocked Term -> m (Blocked Term)
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocked Term -> m (Blocked Term))
-> Blocked Term -> m (Blocked Term)
forall a b. (a -> b) -> a -> b
$ Term -> Blocked Term
forall a. a -> Blocked a
notBlocked Term
v
unfoldInlined :: (HasConstInfo m, MonadReduce m) => Term -> m Term
unfoldInlined :: Term -> m Term
unfoldInlined v :: Term
v = do
Bool
inTypes <- Lens' Bool TCEnv -> m Bool
forall (m :: * -> *) a. MonadTCEnv m => Lens' a TCEnv -> m a
viewTC Lens' Bool TCEnv
eWorkingOnTypes
case Term
v of
_ | Bool
inTypes -> Term -> m Term
forall (m :: * -> *) a. Monad m => a -> m a
return Term
v
Def f :: QName
f es :: Elims
es -> do
Definition
info <- QName -> m Definition
forall (m :: * -> *). HasConstInfo m => QName -> m Definition
getConstInfo QName
f
let def :: Defn
def = Definition -> Defn
theDef Definition
info
irr :: Bool
irr = ArgInfo -> Bool
forall a. LensRelevance a => a -> Bool
isIrrelevant (ArgInfo -> Bool) -> ArgInfo -> Bool
forall a b. (a -> b) -> a -> b
$ Definition -> ArgInfo
defArgInfo Definition
info
case Defn
def of
Function{ funCompiled :: Defn -> Maybe CompiledClauses
funCompiled = Just Done{}, funDelayed :: Defn -> Delayed
funDelayed = Delayed
NotDelayed }
| Defn
def Defn -> Lens' Bool Defn -> Bool
forall o i. o -> Lens' i o -> i
^. Lens' Bool Defn
funInline , Bool -> Bool
not Bool
irr -> ReduceM Term -> m Term
forall (m :: * -> *) a. MonadReduce m => ReduceM a -> m a
liftReduce (ReduceM Term -> m Term) -> ReduceM Term -> m Term
forall a b. (a -> b) -> a -> b
$
Blocked Term -> Term
forall t. Blocked t -> t
ignoreBlocking (Blocked Term -> Term) -> ReduceM (Blocked Term) -> ReduceM Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool
-> (Term -> ReduceM (Blocked Term))
-> Term
-> QName
-> Elims
-> ReduceM (Blocked Term)
unfoldDefinitionE Bool
False (Blocked Term -> ReduceM (Blocked Term)
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocked Term -> ReduceM (Blocked Term))
-> (Term -> Blocked Term) -> Term -> ReduceM (Blocked Term)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term -> Blocked Term
forall a. a -> Blocked a
notBlocked) (QName -> Elims -> Term
Def QName
f []) QName
f Elims
es
_ -> Term -> m Term
forall (m :: * -> *) a. Monad m => a -> m a
return Term
v
_ -> Term -> m Term
forall (m :: * -> *) a. Monad m => a -> m a
return Term
v
appDef_ :: QName -> Term -> [Clause] -> Maybe CompiledClauses -> RewriteRules -> MaybeReducedArgs -> ReduceM (Reduced (Blocked Term) Term)
appDef_ :: QName
-> Term
-> [Clause]
-> Maybe CompiledClauses
-> RewriteRules
-> MaybeReducedArgs
-> ReduceM (Reduced (Blocked Term) Term)
appDef_ f :: QName
f v0 :: Term
v0 cls :: [Clause]
cls mcc :: Maybe CompiledClauses
mcc rewr :: RewriteRules
rewr args :: MaybeReducedArgs
args = QName
-> Term
-> [Clause]
-> Maybe CompiledClauses
-> RewriteRules
-> [MaybeReduced Elim]
-> ReduceM (Reduced (Blocked Term) Term)
appDefE_ QName
f Term
v0 [Clause]
cls Maybe CompiledClauses
mcc RewriteRules
rewr ([MaybeReduced Elim] -> ReduceM (Reduced (Blocked Term) Term))
-> [MaybeReduced Elim] -> ReduceM (Reduced (Blocked Term) Term)
forall a b. (a -> b) -> a -> b
$ (MaybeReduced (Arg Term) -> MaybeReduced Elim)
-> MaybeReducedArgs -> [MaybeReduced Elim]
forall a b. (a -> b) -> [a] -> [b]
map ((Arg Term -> Elim) -> MaybeReduced (Arg Term) -> MaybeReduced Elim
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Arg Term -> Elim
forall a. Arg a -> Elim' a
Apply) MaybeReducedArgs
args
appDefE_ :: QName -> Term -> [Clause] -> Maybe CompiledClauses -> RewriteRules -> MaybeReducedElims -> ReduceM (Reduced (Blocked Term) Term)
appDefE_ :: QName
-> Term
-> [Clause]
-> Maybe CompiledClauses
-> RewriteRules
-> [MaybeReduced Elim]
-> ReduceM (Reduced (Blocked Term) Term)
appDefE_ f :: QName
f v0 :: Term
v0 cls :: [Clause]
cls mcc :: Maybe CompiledClauses
mcc rewr :: RewriteRules
rewr args :: [MaybeReduced Elim]
args =
(TCEnv -> TCEnv)
-> ReduceM (Reduced (Blocked Term) Term)
-> ReduceM (Reduced (Blocked Term) Term)
forall (m :: * -> *) a.
MonadTCEnv m =>
(TCEnv -> TCEnv) -> m a -> m a
localTC (\ e :: TCEnv
e -> TCEnv
e { envAppDef :: Maybe QName
envAppDef = QName -> Maybe QName
forall a. a -> Maybe a
Just QName
f }) (ReduceM (Reduced (Blocked Term) Term)
-> ReduceM (Reduced (Blocked Term) Term))
-> ReduceM (Reduced (Blocked Term) Term)
-> ReduceM (Reduced (Blocked Term) Term)
forall a b. (a -> b) -> a -> b
$
ReduceM (Reduced (Blocked Term) Term)
-> (CompiledClauses -> ReduceM (Reduced (Blocked Term) Term))
-> Maybe CompiledClauses
-> ReduceM (Reduced (Blocked Term) Term)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Term
-> [Clause]
-> RewriteRules
-> [MaybeReduced Elim]
-> ReduceM (Reduced (Blocked Term) Term)
appDefE' Term
v0 [Clause]
cls RewriteRules
rewr [MaybeReduced Elim]
args)
(\cc :: CompiledClauses
cc -> Term
-> CompiledClauses
-> RewriteRules
-> [MaybeReduced Elim]
-> ReduceM (Reduced (Blocked Term) Term)
appDefE Term
v0 CompiledClauses
cc RewriteRules
rewr [MaybeReduced Elim]
args) Maybe CompiledClauses
mcc
appDef :: Term -> CompiledClauses -> RewriteRules -> MaybeReducedArgs -> ReduceM (Reduced (Blocked Term) Term)
appDef :: Term
-> CompiledClauses
-> RewriteRules
-> MaybeReducedArgs
-> ReduceM (Reduced (Blocked Term) Term)
appDef v :: Term
v cc :: CompiledClauses
cc rewr :: RewriteRules
rewr args :: MaybeReducedArgs
args = Term
-> CompiledClauses
-> RewriteRules
-> [MaybeReduced Elim]
-> ReduceM (Reduced (Blocked Term) Term)
appDefE Term
v CompiledClauses
cc RewriteRules
rewr ([MaybeReduced Elim] -> ReduceM (Reduced (Blocked Term) Term))
-> [MaybeReduced Elim] -> ReduceM (Reduced (Blocked Term) Term)
forall a b. (a -> b) -> a -> b
$ (MaybeReduced (Arg Term) -> MaybeReduced Elim)
-> MaybeReducedArgs -> [MaybeReduced Elim]
forall a b. (a -> b) -> [a] -> [b]
map ((Arg Term -> Elim) -> MaybeReduced (Arg Term) -> MaybeReduced Elim
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Arg Term -> Elim
forall a. Arg a -> Elim' a
Apply) MaybeReducedArgs
args
appDefE :: Term -> CompiledClauses -> RewriteRules -> MaybeReducedElims -> ReduceM (Reduced (Blocked Term) Term)
appDefE :: Term
-> CompiledClauses
-> RewriteRules
-> [MaybeReduced Elim]
-> ReduceM (Reduced (Blocked Term) Term)
appDefE v :: Term
v cc :: CompiledClauses
cc rewr :: RewriteRules
rewr es :: [MaybeReduced Elim]
es = do
String
-> Int
-> TCM Doc
-> ReduceM (Reduced (Blocked Term) Term)
-> ReduceM (Reduced (Blocked Term) Term)
forall (m :: * -> *) a.
MonadDebug m =>
String -> Int -> TCM Doc -> m a -> m a
traceSDoc "tc.reduce" 90 ("appDefE v = " TCM Doc -> TCM Doc -> TCM Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> Term -> TCM Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM Term
v) (ReduceM (Reduced (Blocked Term) Term)
-> ReduceM (Reduced (Blocked Term) Term))
-> ReduceM (Reduced (Blocked Term) Term)
-> ReduceM (Reduced (Blocked Term) Term)
forall a b. (a -> b) -> a -> b
$ do
Reduced (Blocked Elims) Term
r <- CompiledClauses
-> [MaybeReduced Elim] -> ReduceM (Reduced (Blocked Elims) Term)
matchCompiledE CompiledClauses
cc [MaybeReduced Elim]
es
case Reduced (Blocked Elims) Term
r of
YesReduction simpl :: Simplification
simpl t :: Term
t -> Reduced (Blocked Term) Term
-> ReduceM (Reduced (Blocked Term) Term)
forall (m :: * -> *) a. Monad m => a -> m a
return (Reduced (Blocked Term) Term
-> ReduceM (Reduced (Blocked Term) Term))
-> Reduced (Blocked Term) Term
-> ReduceM (Reduced (Blocked Term) Term)
forall a b. (a -> b) -> a -> b
$ Simplification -> Term -> Reduced (Blocked Term) Term
forall no yes. Simplification -> yes -> Reduced no yes
YesReduction Simplification
simpl Term
t
NoReduction es' :: Blocked Elims
es' -> Blocked ()
-> Term
-> RewriteRules
-> Elims
-> ReduceM (Reduced (Blocked Term) Term)
rewrite (Blocked Elims -> Blocked ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Blocked Elims
es') Term
v RewriteRules
rewr (Blocked Elims -> Elims
forall t. Blocked t -> t
ignoreBlocking Blocked Elims
es')
appDef' :: Term -> [Clause] -> RewriteRules -> MaybeReducedArgs -> ReduceM (Reduced (Blocked Term) Term)
appDef' :: Term
-> [Clause]
-> RewriteRules
-> MaybeReducedArgs
-> ReduceM (Reduced (Blocked Term) Term)
appDef' v :: Term
v cls :: [Clause]
cls rewr :: RewriteRules
rewr args :: MaybeReducedArgs
args = Term
-> [Clause]
-> RewriteRules
-> [MaybeReduced Elim]
-> ReduceM (Reduced (Blocked Term) Term)
appDefE' Term
v [Clause]
cls RewriteRules
rewr ([MaybeReduced Elim] -> ReduceM (Reduced (Blocked Term) Term))
-> [MaybeReduced Elim] -> ReduceM (Reduced (Blocked Term) Term)
forall a b. (a -> b) -> a -> b
$ (MaybeReduced (Arg Term) -> MaybeReduced Elim)
-> MaybeReducedArgs -> [MaybeReduced Elim]
forall a b. (a -> b) -> [a] -> [b]
map ((Arg Term -> Elim) -> MaybeReduced (Arg Term) -> MaybeReduced Elim
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Arg Term -> Elim
forall a. Arg a -> Elim' a
Apply) MaybeReducedArgs
args
appDefE' :: Term -> [Clause] -> RewriteRules -> MaybeReducedElims -> ReduceM (Reduced (Blocked Term) Term)
appDefE' :: Term
-> [Clause]
-> RewriteRules
-> [MaybeReduced Elim]
-> ReduceM (Reduced (Blocked Term) Term)
appDefE' v :: Term
v cls :: [Clause]
cls rewr :: RewriteRules
rewr es :: [MaybeReduced Elim]
es = String
-> Int
-> TCM Doc
-> ReduceM (Reduced (Blocked Term) Term)
-> ReduceM (Reduced (Blocked Term) Term)
forall (m :: * -> *) a.
MonadDebug m =>
String -> Int -> TCM Doc -> m a -> m a
traceSDoc "tc.reduce" 90 ("appDefE' v = " TCM Doc -> TCM Doc -> TCM Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> Term -> TCM Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM Term
v) (ReduceM (Reduced (Blocked Term) Term)
-> ReduceM (Reduced (Blocked Term) Term))
-> ReduceM (Reduced (Blocked Term) Term)
-> ReduceM (Reduced (Blocked Term) Term)
forall a b. (a -> b) -> a -> b
$ do
[Clause] -> Elims -> ReduceM (Reduced (Blocked Term) Term)
goCls [Clause]
cls (Elims -> ReduceM (Reduced (Blocked Term) Term))
-> Elims -> ReduceM (Reduced (Blocked Term) Term)
forall a b. (a -> b) -> a -> b
$ (MaybeReduced Elim -> Elim) -> [MaybeReduced Elim] -> Elims
forall a b. (a -> b) -> [a] -> [b]
map MaybeReduced Elim -> Elim
forall a. MaybeReduced a -> a
ignoreReduced [MaybeReduced Elim]
es
where
goCls :: [Clause] -> [Elim] -> ReduceM (Reduced (Blocked Term) Term)
goCls :: [Clause] -> Elims -> ReduceM (Reduced (Blocked Term) Term)
goCls cl :: [Clause]
cl es :: Elims
es = do
case [Clause]
cl of
[] -> Blocked ()
-> Term
-> RewriteRules
-> Elims
-> ReduceM (Reduced (Blocked Term) Term)
rewrite (NotBlocked -> () -> Blocked ()
forall t. NotBlocked -> t -> Blocked t
NotBlocked NotBlocked
MissingClauses ()) Term
v RewriteRules
rewr Elims
es
cl :: Clause
cl : cls :: [Clause]
cls -> do
let pats :: NAPs
pats = Clause -> NAPs
namedClausePats Clause
cl
body :: Maybe Term
body = Clause -> Maybe Term
clauseBody Clause
cl
npats :: Int
npats = NAPs -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length NAPs
pats
nvars :: Int
nvars = Telescope -> Int
forall a. Sized a => a -> Int
size (Telescope -> Int) -> Telescope -> Int
forall a b. (a -> b) -> a -> b
$ Clause -> Telescope
clauseTel Clause
cl
if Elims -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Elims
es Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
npats then [Clause] -> Elims -> ReduceM (Reduced (Blocked Term) Term)
goCls [Clause]
cls Elims
es else do
let (es0 :: Elims
es0, es1 :: Elims
es1) = Int -> Elims -> (Elims, Elims)
forall a. Int -> [a] -> ([a], [a])
splitAt Int
npats Elims
es
(m :: Match Term
m, es0 :: Elims
es0) <- NAPs -> Elims -> ReduceM (Match Term, Elims)
matchCopatterns NAPs
pats Elims
es0
Elims
es <- Elims -> ReduceM Elims
forall (m :: * -> *) a. Monad m => a -> m a
return (Elims -> ReduceM Elims) -> Elims -> ReduceM Elims
forall a b. (a -> b) -> a -> b
$ Elims
es0 Elims -> Elims -> Elims
forall a. [a] -> [a] -> [a]
++ Elims
es1
case Match Term
m of
No -> [Clause] -> Elims -> ReduceM (Reduced (Blocked Term) Term)
goCls [Clause]
cls Elims
es
DontKnow b :: Blocked ()
b -> Blocked ()
-> Term
-> RewriteRules
-> Elims
-> ReduceM (Reduced (Blocked Term) Term)
rewrite Blocked ()
b Term
v RewriteRules
rewr Elims
es
Yes simpl :: Simplification
simpl vs :: IntMap (Arg Term)
vs
| Just w :: Term
w <- Maybe Term
body -> do
let sigma :: Substitution' Term
sigma = Empty -> Int -> IntMap (Arg Term) -> Substitution' Term
forall a.
DeBruijn a =>
Empty -> Int -> IntMap (Arg a) -> Substitution' a
buildSubstitution Empty
forall a. HasCallStack => a
__IMPOSSIBLE__ Int
nvars IntMap (Arg Term)
vs
Reduced (Blocked Term) Term
-> ReduceM (Reduced (Blocked Term) Term)
forall (m :: * -> *) a. Monad m => a -> m a
return (Reduced (Blocked Term) Term
-> ReduceM (Reduced (Blocked Term) Term))
-> Reduced (Blocked Term) Term
-> ReduceM (Reduced (Blocked Term) Term)
forall a b. (a -> b) -> a -> b
$ Simplification -> Term -> Reduced (Blocked Term) Term
forall no yes. Simplification -> yes -> Reduced no yes
YesReduction Simplification
simpl (Term -> Reduced (Blocked Term) Term)
-> Term -> Reduced (Blocked Term) Term
forall a b. (a -> b) -> a -> b
$ Substitution' Term -> Term -> Term
forall t a. Subst t a => Substitution' t -> a -> a
applySubst Substitution' Term
sigma Term
w Term -> Elims -> Term
forall t. Apply t => t -> Elims -> t
`applyE` Elims
es1
| Bool
otherwise -> Blocked ()
-> Term
-> RewriteRules
-> Elims
-> ReduceM (Reduced (Blocked Term) Term)
rewrite (NotBlocked -> () -> Blocked ()
forall t. NotBlocked -> t -> Blocked t
NotBlocked NotBlocked
AbsurdMatch ()) Term
v RewriteRules
rewr Elims
es
instance Reduce a => Reduce (Closure a) where
reduce' :: Closure a -> ReduceM (Closure a)
reduce' cl :: Closure a
cl = do
a
x <- Closure a -> (a -> ReduceM a) -> ReduceM a
forall a c b. LensClosure a c => c -> (a -> ReduceM b) -> ReduceM b
enterClosure Closure a
cl a -> ReduceM a
forall t. Reduce t => t -> ReduceM t
reduce'
Closure a -> ReduceM (Closure a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Closure a -> ReduceM (Closure a))
-> Closure a -> ReduceM (Closure a)
forall a b. (a -> b) -> a -> b
$ Closure a
cl { clValue :: a
clValue = a
x }
instance Reduce Telescope where
reduce' :: Telescope -> ReduceM Telescope
reduce' EmptyTel = Telescope -> ReduceM Telescope
forall (m :: * -> *) a. Monad m => a -> m a
return Telescope
forall a. Tele a
EmptyTel
reduce' (ExtendTel a :: Dom Type
a tel :: Abs Telescope
tel) = Dom Type -> Abs Telescope -> Telescope
forall a. a -> Abs (Tele a) -> Tele a
ExtendTel (Dom Type -> Abs Telescope -> Telescope)
-> ReduceM (Dom Type) -> ReduceM (Abs Telescope -> Telescope)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Dom Type -> ReduceM (Dom Type)
forall t. Reduce t => t -> ReduceM t
reduce' Dom Type
a ReduceM (Abs Telescope -> Telescope)
-> ReduceM (Abs Telescope) -> ReduceM Telescope
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Abs Telescope -> ReduceM (Abs Telescope)
forall t. Reduce t => t -> ReduceM t
reduce' Abs Telescope
tel
instance Reduce Constraint where
reduce' :: Constraint -> ReduceM Constraint
reduce' (ValueCmp cmp :: Comparison
cmp t :: CompareAs
t u :: Term
u v :: Term
v) = do
(t :: CompareAs
t,u :: Term
u,v :: Term
v) <- (CompareAs, Term, Term) -> ReduceM (CompareAs, Term, Term)
forall t. Reduce t => t -> ReduceM t
reduce' (CompareAs
t,Term
u,Term
v)
Constraint -> ReduceM Constraint
forall (m :: * -> *) a. Monad m => a -> m a
return (Constraint -> ReduceM Constraint)
-> Constraint -> ReduceM Constraint
forall a b. (a -> b) -> a -> b
$ Comparison -> CompareAs -> Term -> Term -> Constraint
ValueCmp Comparison
cmp CompareAs
t Term
u Term
v
reduce' (ValueCmpOnFace cmp :: Comparison
cmp p :: Term
p t :: Type
t u :: Term
u v :: Term
v) = do
((p :: Term
p,t :: Type
t),u :: Term
u,v :: Term
v) <- ((Term, Type), Term, Term) -> ReduceM ((Term, Type), Term, Term)
forall t. Reduce t => t -> ReduceM t
reduce' ((Term
p,Type
t),Term
u,Term
v)
Constraint -> ReduceM Constraint
forall (m :: * -> *) a. Monad m => a -> m a
return (Constraint -> ReduceM Constraint)
-> Constraint -> ReduceM Constraint
forall a b. (a -> b) -> a -> b
$ Comparison -> Term -> Type -> Term -> Term -> Constraint
ValueCmpOnFace Comparison
cmp Term
p Type
t Term
u Term
v
reduce' (ElimCmp cmp :: [Polarity]
cmp fs :: [IsForced]
fs t :: Type
t v :: Term
v as :: Elims
as bs :: Elims
bs) =
[Polarity]
-> [IsForced] -> Type -> Term -> Elims -> Elims -> Constraint
ElimCmp [Polarity]
cmp [IsForced]
fs (Type -> Term -> Elims -> Elims -> Constraint)
-> ReduceM Type -> ReduceM (Term -> Elims -> Elims -> Constraint)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Type -> ReduceM Type
forall t. Reduce t => t -> ReduceM t
reduce' Type
t ReduceM (Term -> Elims -> Elims -> Constraint)
-> ReduceM Term -> ReduceM (Elims -> Elims -> Constraint)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Term -> ReduceM Term
forall t. Reduce t => t -> ReduceM t
reduce' Term
v ReduceM (Elims -> Elims -> Constraint)
-> ReduceM Elims -> ReduceM (Elims -> Constraint)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Elims -> ReduceM Elims
forall t. Reduce t => t -> ReduceM t
reduce' Elims
as ReduceM (Elims -> Constraint)
-> ReduceM Elims -> ReduceM Constraint
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Elims -> ReduceM Elims
forall t. Reduce t => t -> ReduceM t
reduce' Elims
bs
reduce' (LevelCmp cmp :: Comparison
cmp u :: Level
u v :: Level
v) = (Level -> Level -> Constraint) -> (Level, Level) -> Constraint
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (Comparison -> Level -> Level -> Constraint
LevelCmp Comparison
cmp) ((Level, Level) -> Constraint)
-> ReduceM (Level, Level) -> ReduceM Constraint
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Level, Level) -> ReduceM (Level, Level)
forall t. Reduce t => t -> ReduceM t
reduce' (Level
u,Level
v)
reduce' (TelCmp a :: Type
a b :: Type
b cmp :: Comparison
cmp tela :: Telescope
tela telb :: Telescope
telb) = (Telescope -> Telescope -> Constraint)
-> (Telescope, Telescope) -> Constraint
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (Type -> Type -> Comparison -> Telescope -> Telescope -> Constraint
TelCmp Type
a Type
b Comparison
cmp) ((Telescope, Telescope) -> Constraint)
-> ReduceM (Telescope, Telescope) -> ReduceM Constraint
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Telescope, Telescope) -> ReduceM (Telescope, Telescope)
forall t. Reduce t => t -> ReduceM t
reduce' (Telescope
tela,Telescope
telb)
reduce' (SortCmp cmp :: Comparison
cmp a :: Sort
a b :: Sort
b) = (Sort -> Sort -> Constraint) -> (Sort, Sort) -> Constraint
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (Comparison -> Sort -> Sort -> Constraint
SortCmp Comparison
cmp) ((Sort, Sort) -> Constraint)
-> ReduceM (Sort, Sort) -> ReduceM Constraint
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Sort, Sort) -> ReduceM (Sort, Sort)
forall t. Reduce t => t -> ReduceM t
reduce' (Sort
a,Sort
b)
reduce' (Guarded c :: Constraint
c pid :: ProblemId
pid) = Constraint -> ProblemId -> Constraint
Guarded (Constraint -> ProblemId -> Constraint)
-> ReduceM Constraint -> ReduceM (ProblemId -> Constraint)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Constraint -> ReduceM Constraint
forall t. Reduce t => t -> ReduceM t
reduce' Constraint
c ReduceM (ProblemId -> Constraint)
-> ReduceM ProblemId -> ReduceM Constraint
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ProblemId -> ReduceM ProblemId
forall (f :: * -> *) a. Applicative f => a -> f a
pure ProblemId
pid
reduce' (UnBlock m :: MetaId
m) = Constraint -> ReduceM Constraint
forall (m :: * -> *) a. Monad m => a -> m a
return (Constraint -> ReduceM Constraint)
-> Constraint -> ReduceM Constraint
forall a b. (a -> b) -> a -> b
$ MetaId -> Constraint
UnBlock MetaId
m
reduce' (FindInstance m :: MetaId
m b :: Maybe MetaId
b cands :: Maybe [Candidate]
cands) = MetaId -> Maybe MetaId -> Maybe [Candidate] -> Constraint
FindInstance MetaId
m Maybe MetaId
b (Maybe [Candidate] -> Constraint)
-> ReduceM (Maybe [Candidate]) -> ReduceM Constraint
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Candidate] -> ReduceM [Candidate])
-> Maybe [Candidate] -> ReduceM (Maybe [Candidate])
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM [Candidate] -> ReduceM [Candidate]
forall t. Reduce t => t -> ReduceM t
reduce' Maybe [Candidate]
cands
reduce' (IsEmpty r :: Range
r t :: Type
t) = Range -> Type -> Constraint
IsEmpty Range
r (Type -> Constraint) -> ReduceM Type -> ReduceM Constraint
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Type -> ReduceM Type
forall t. Reduce t => t -> ReduceM t
reduce' Type
t
reduce' (CheckSizeLtSat t :: Term
t) = Term -> Constraint
CheckSizeLtSat (Term -> Constraint) -> ReduceM Term -> ReduceM Constraint
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term -> ReduceM Term
forall t. Reduce t => t -> ReduceM t
reduce' Term
t
reduce' c :: Constraint
c@CheckFunDef{} = Constraint -> ReduceM Constraint
forall (m :: * -> *) a. Monad m => a -> m a
return Constraint
c
reduce' (HasBiggerSort a :: Sort
a) = Sort -> Constraint
HasBiggerSort (Sort -> Constraint) -> ReduceM Sort -> ReduceM Constraint
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sort -> ReduceM Sort
forall t. Reduce t => t -> ReduceM t
reduce' Sort
a
reduce' (HasPTSRule a :: Dom Type
a b :: Abs Sort
b) = (Dom Type -> Abs Sort -> Constraint)
-> (Dom Type, Abs Sort) -> Constraint
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Dom Type -> Abs Sort -> Constraint
HasPTSRule ((Dom Type, Abs Sort) -> Constraint)
-> ReduceM (Dom Type, Abs Sort) -> ReduceM Constraint
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Dom Type, Abs Sort) -> ReduceM (Dom Type, Abs Sort)
forall t. Reduce t => t -> ReduceM t
reduce' (Dom Type
a,Abs Sort
b)
reduce' (UnquoteTactic m :: Maybe MetaId
m t :: Term
t h :: Term
h g :: Type
g) = Maybe MetaId -> Term -> Term -> Type -> Constraint
UnquoteTactic Maybe MetaId
m (Term -> Term -> Type -> Constraint)
-> ReduceM Term -> ReduceM (Term -> Type -> Constraint)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term -> ReduceM Term
forall t. Reduce t => t -> ReduceM t
reduce' Term
t ReduceM (Term -> Type -> Constraint)
-> ReduceM Term -> ReduceM (Type -> Constraint)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Term -> ReduceM Term
forall t. Reduce t => t -> ReduceM t
reduce' Term
h ReduceM (Type -> Constraint) -> ReduceM Type -> ReduceM Constraint
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Type -> ReduceM Type
forall t. Reduce t => t -> ReduceM t
reduce' Type
g
reduce' c :: Constraint
c@CheckMetaInst{} = Constraint -> ReduceM Constraint
forall (m :: * -> *) a. Monad m => a -> m a
return Constraint
c
instance Reduce CompareAs where
reduce' :: CompareAs -> ReduceM CompareAs
reduce' (AsTermsOf a :: Type
a) = Type -> CompareAs
AsTermsOf (Type -> CompareAs) -> ReduceM Type -> ReduceM CompareAs
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Type -> ReduceM Type
forall t. Reduce t => t -> ReduceM t
reduce' Type
a
reduce' AsSizes = CompareAs -> ReduceM CompareAs
forall (m :: * -> *) a. Monad m => a -> m a
return CompareAs
AsSizes
reduce' AsTypes = CompareAs -> ReduceM CompareAs
forall (m :: * -> *) a. Monad m => a -> m a
return CompareAs
AsTypes
instance Reduce e => Reduce (Map k e) where
reduce' :: Map k e -> ReduceM (Map k e)
reduce' = (e -> ReduceM e) -> Map k e -> ReduceM (Map k e)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse e -> ReduceM e
forall t. Reduce t => t -> ReduceM t
reduce'
instance Reduce Candidate where
reduce' :: Candidate -> ReduceM Candidate
reduce' (Candidate u :: Term
u t :: Type
t ov :: Bool
ov) = Term -> Type -> Bool -> Candidate
Candidate (Term -> Type -> Bool -> Candidate)
-> ReduceM Term -> ReduceM (Type -> Bool -> Candidate)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term -> ReduceM Term
forall t. Reduce t => t -> ReduceM t
reduce' Term
u ReduceM (Type -> Bool -> Candidate)
-> ReduceM Type -> ReduceM (Bool -> Candidate)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Type -> ReduceM Type
forall t. Reduce t => t -> ReduceM t
reduce' Type
t ReduceM (Bool -> Candidate) -> ReduceM Bool -> ReduceM Candidate
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Bool -> ReduceM Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
ov
instance Reduce EqualityView where
reduce' :: EqualityView -> ReduceM EqualityView
reduce' (OtherType t :: Type
t) = Type -> EqualityView
OtherType
(Type -> EqualityView) -> ReduceM Type -> ReduceM EqualityView
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Type -> ReduceM Type
forall t. Reduce t => t -> ReduceM t
reduce' Type
t
reduce' (EqualityType s :: Sort
s eq :: QName
eq l :: [Arg Term]
l t :: Arg Term
t a :: Arg Term
a b :: Arg Term
b) = Sort
-> QName
-> [Arg Term]
-> Arg Term
-> Arg Term
-> Arg Term
-> EqualityView
EqualityType
(Sort
-> QName
-> [Arg Term]
-> Arg Term
-> Arg Term
-> Arg Term
-> EqualityView)
-> ReduceM Sort
-> ReduceM
(QName
-> [Arg Term] -> Arg Term -> Arg Term -> Arg Term -> EqualityView)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sort -> ReduceM Sort
forall t. Reduce t => t -> ReduceM t
reduce' Sort
s
ReduceM
(QName
-> [Arg Term] -> Arg Term -> Arg Term -> Arg Term -> EqualityView)
-> ReduceM QName
-> ReduceM
([Arg Term] -> Arg Term -> Arg Term -> Arg Term -> EqualityView)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> QName -> ReduceM QName
forall (m :: * -> *) a. Monad m => a -> m a
return QName
eq
ReduceM
([Arg Term] -> Arg Term -> Arg Term -> Arg Term -> EqualityView)
-> ReduceM [Arg Term]
-> ReduceM (Arg Term -> Arg Term -> Arg Term -> EqualityView)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Arg Term -> ReduceM (Arg Term))
-> [Arg Term] -> ReduceM [Arg Term]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Arg Term -> ReduceM (Arg Term)
forall t. Reduce t => t -> ReduceM t
reduce' [Arg Term]
l
ReduceM (Arg Term -> Arg Term -> Arg Term -> EqualityView)
-> ReduceM (Arg Term)
-> ReduceM (Arg Term -> Arg Term -> EqualityView)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Arg Term -> ReduceM (Arg Term)
forall t. Reduce t => t -> ReduceM t
reduce' Arg Term
t
ReduceM (Arg Term -> Arg Term -> EqualityView)
-> ReduceM (Arg Term) -> ReduceM (Arg Term -> EqualityView)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Arg Term -> ReduceM (Arg Term)
forall t. Reduce t => t -> ReduceM t
reduce' Arg Term
a
ReduceM (Arg Term -> EqualityView)
-> ReduceM (Arg Term) -> ReduceM EqualityView
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Arg Term -> ReduceM (Arg Term)
forall t. Reduce t => t -> ReduceM t
reduce' Arg Term
b
instance Reduce t => Reduce (IPBoundary' t) where
reduce' :: IPBoundary' t -> ReduceM (IPBoundary' t)
reduce' = (t -> ReduceM t) -> IPBoundary' t -> ReduceM (IPBoundary' t)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse t -> ReduceM t
forall t. Reduce t => t -> ReduceM t
reduce'
reduceB' :: IPBoundary' t -> ReduceM (Blocked (IPBoundary' t))
reduceB' = (IPBoundary' (Blocked t) -> Blocked (IPBoundary' t))
-> ReduceM (IPBoundary' (Blocked t))
-> ReduceM (Blocked (IPBoundary' t))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap IPBoundary' (Blocked t) -> Blocked (IPBoundary' t)
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA (ReduceM (IPBoundary' (Blocked t))
-> ReduceM (Blocked (IPBoundary' t)))
-> (IPBoundary' t -> ReduceM (IPBoundary' (Blocked t)))
-> IPBoundary' t
-> ReduceM (Blocked (IPBoundary' t))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (t -> ReduceM (Blocked t))
-> IPBoundary' t -> ReduceM (IPBoundary' (Blocked t))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse t -> ReduceM (Blocked t)
forall t. Reduce t => t -> ReduceM (Blocked t)
reduceB'
class Simplify t where
simplify' :: t -> ReduceM t
default simplify' :: (t ~ f a, Traversable f, Simplify a) => t -> ReduceM t
simplify' = (a -> ReduceM a) -> f a -> ReduceM (f a)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> ReduceM a
forall t. Simplify t => t -> ReduceM t
simplify'
instance Simplify t => Simplify [t]
instance Simplify t => Simplify (Map k t)
instance Simplify t => Simplify (Maybe t)
instance Simplify t => Simplify (Strict.Maybe t)
instance Simplify t => Simplify (Arg t)
instance Simplify t => Simplify (Elim' t)
instance Simplify t => Simplify (Named name t)
instance Simplify t => Simplify (IPBoundary' t)
instance (Simplify a, Simplify b) => Simplify (a,b) where
simplify' :: (a, b) -> ReduceM (a, b)
simplify' (x :: a
x,y :: b
y) = (,) (a -> b -> (a, b)) -> ReduceM a -> ReduceM (b -> (a, b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> ReduceM a
forall t. Simplify t => t -> ReduceM t
simplify' a
x ReduceM (b -> (a, b)) -> ReduceM b -> ReduceM (a, b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> b -> ReduceM b
forall t. Simplify t => t -> ReduceM t
simplify' b
y
instance (Simplify a, Simplify b, Simplify c) => Simplify (a,b,c) where
simplify' :: (a, b, c) -> ReduceM (a, b, c)
simplify' (x :: a
x,y :: b
y,z :: c
z) =
do (x :: a
x,(y :: b
y,z :: c
z)) <- (a, (b, c)) -> ReduceM (a, (b, c))
forall t. Simplify t => t -> ReduceM t
simplify' (a
x,(b
y,c
z))
(a, b, c) -> ReduceM (a, b, c)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
x,b
y,c
z)
instance Simplify Bool where
simplify' :: Bool -> ReduceM Bool
simplify' = Bool -> ReduceM Bool
forall (m :: * -> *) a. Monad m => a -> m a
return
instance Simplify Term where
simplify' :: Term -> ReduceM Term
simplify' v :: Term
v = do
Term
v <- Term -> ReduceM Term
forall t. Instantiate t => t -> ReduceM t
instantiate' Term
v
case Term
v of
Def f :: QName
f vs :: Elims
vs -> do
let keepGoing :: a -> a -> m (a, Blocked a)
keepGoing simp :: a
simp v :: a
v = (a, Blocked a) -> m (a, Blocked a)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
simp, a -> Blocked a
forall a. a -> Blocked a
notBlocked a
v)
(simpl :: Simplification
simpl, v :: Blocked Term
v) <- Bool
-> (Simplification
-> Term -> ReduceM (Simplification, Blocked Term))
-> Term
-> QName
-> Elims
-> ReduceM (Simplification, Blocked Term)
unfoldDefinition' Bool
False Simplification -> Term -> ReduceM (Simplification, Blocked Term)
forall (m :: * -> *) a a. Monad m => a -> a -> m (a, Blocked a)
keepGoing (QName -> Elims -> Term
Def QName
f []) QName
f Elims
vs
String -> Int -> TCM Doc -> ReduceM Term -> ReduceM Term
forall (m :: * -> *) a.
MonadDebug m =>
String -> Int -> TCM Doc -> m a -> m a
traceSDoc "tc.simplify'" 90 (
String -> TCM Doc
forall (m :: * -> *). Monad m => String -> m Doc
text ("simplify': unfolding definition returns " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Simplification -> String
forall a. Show a => a -> String
show Simplification
simpl)
TCM Doc -> TCM Doc -> TCM Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> Term -> TCM Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM (Blocked Term -> Term
forall t. Blocked t -> t
ignoreBlocking Blocked Term
v)) (ReduceM Term -> ReduceM Term) -> ReduceM Term -> ReduceM Term
forall a b. (a -> b) -> a -> b
$ do
case Simplification
simpl of
YesSimplification -> Blocked Term -> ReduceM Term
forall t. Simplify t => Blocked t -> ReduceM t
simplifyBlocked' Blocked Term
v
NoSimplification -> QName -> Elims -> Term
Def QName
f (Elims -> Term) -> ReduceM Elims -> ReduceM Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Elims -> ReduceM Elims
forall t. Simplify t => t -> ReduceM t
simplify' Elims
vs
MetaV x :: MetaId
x vs :: Elims
vs -> MetaId -> Elims -> Term
MetaV MetaId
x (Elims -> Term) -> ReduceM Elims -> ReduceM Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Elims -> ReduceM Elims
forall t. Simplify t => t -> ReduceM t
simplify' Elims
vs
Con c :: ConHead
c ci :: ConInfo
ci vs :: Elims
vs-> ConHead -> ConInfo -> Elims -> Term
Con ConHead
c ConInfo
ci (Elims -> Term) -> ReduceM Elims -> ReduceM Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Elims -> ReduceM Elims
forall t. Simplify t => t -> ReduceM t
simplify' Elims
vs
Sort s :: Sort
s -> Sort -> Term
Sort (Sort -> Term) -> ReduceM Sort -> ReduceM Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sort -> ReduceM Sort
forall t. Simplify t => t -> ReduceM t
simplify' Sort
s
Level l :: Level
l -> Level -> Term
levelTm (Level -> Term) -> ReduceM Level -> ReduceM Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Level -> ReduceM Level
forall t. Simplify t => t -> ReduceM t
simplify' Level
l
Pi a :: Dom Type
a b :: Abs Type
b -> Dom Type -> Abs Type -> Term
Pi (Dom Type -> Abs Type -> Term)
-> ReduceM (Dom Type) -> ReduceM (Abs Type -> Term)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Dom Type -> ReduceM (Dom Type)
forall t. Simplify t => t -> ReduceM t
simplify' Dom Type
a ReduceM (Abs Type -> Term) -> ReduceM (Abs Type) -> ReduceM Term
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Abs Type -> ReduceM (Abs Type)
forall t. Simplify t => t -> ReduceM t
simplify' Abs Type
b
Lit l :: Literal
l -> Term -> ReduceM Term
forall (m :: * -> *) a. Monad m => a -> m a
return Term
v
Var i :: Int
i vs :: Elims
vs -> Int -> Elims -> Term
Var Int
i (Elims -> Term) -> ReduceM Elims -> ReduceM Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Elims -> ReduceM Elims
forall t. Simplify t => t -> ReduceM t
simplify' Elims
vs
Lam h :: ArgInfo
h v :: Abs Term
v -> ArgInfo -> Abs Term -> Term
Lam ArgInfo
h (Abs Term -> Term) -> ReduceM (Abs Term) -> ReduceM Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Abs Term -> ReduceM (Abs Term)
forall t. Simplify t => t -> ReduceM t
simplify' Abs Term
v
DontCare v :: Term
v -> Term -> Term
dontCare (Term -> Term) -> ReduceM Term -> ReduceM Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term -> ReduceM Term
forall t. Simplify t => t -> ReduceM t
simplify' Term
v
Dummy{} -> Term -> ReduceM Term
forall (m :: * -> *) a. Monad m => a -> m a
return Term
v
simplifyBlocked' :: Simplify t => Blocked t -> ReduceM t
simplifyBlocked' :: Blocked t -> ReduceM t
simplifyBlocked' (Blocked _ t :: t
t) = t -> ReduceM t
forall (m :: * -> *) a. Monad m => a -> m a
return t
t
simplifyBlocked' (NotBlocked _ t :: t
t) = t -> ReduceM t
forall t. Simplify t => t -> ReduceM t
simplify' t
t
instance Simplify t => Simplify (Type' t) where
simplify' :: Type' t -> ReduceM (Type' t)
simplify' (El s :: Sort
s t :: t
t) = Sort -> t -> Type' t
forall t a. Sort' t -> a -> Type'' t a
El (Sort -> t -> Type' t) -> ReduceM Sort -> ReduceM (t -> Type' t)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sort -> ReduceM Sort
forall t. Simplify t => t -> ReduceM t
simplify' Sort
s ReduceM (t -> Type' t) -> ReduceM t -> ReduceM (Type' t)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> t -> ReduceM t
forall t. Simplify t => t -> ReduceM t
simplify' t
t
instance Simplify Sort where
simplify' :: Sort -> ReduceM Sort
simplify' s :: Sort
s = do
case Sort
s of
PiSort a :: Dom Type
a s :: Abs Sort
s -> Dom Type -> Abs Sort -> Sort
piSort (Dom Type -> Abs Sort -> Sort)
-> ReduceM (Dom Type) -> ReduceM (Abs Sort -> Sort)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Dom Type -> ReduceM (Dom Type)
forall t. Simplify t => t -> ReduceM t
simplify' Dom Type
a ReduceM (Abs Sort -> Sort) -> ReduceM (Abs Sort) -> ReduceM Sort
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Abs Sort -> ReduceM (Abs Sort)
forall t. Simplify t => t -> ReduceM t
simplify' Abs Sort
s
FunSort s1 :: Sort
s1 s2 :: Sort
s2 -> Sort -> Sort -> Sort
funSort (Sort -> Sort -> Sort) -> ReduceM Sort -> ReduceM (Sort -> Sort)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sort -> ReduceM Sort
forall t. Simplify t => t -> ReduceM t
simplify' Sort
s1 ReduceM (Sort -> Sort) -> ReduceM Sort -> ReduceM Sort
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Sort -> ReduceM Sort
forall t. Simplify t => t -> ReduceM t
simplify' Sort
s2
UnivSort s :: Sort
s -> do
Maybe Sort
ui <- ReduceM (Maybe Sort)
forall (m :: * -> *). HasOptions m => m (Maybe Sort)
univInf
Maybe Sort -> Sort -> Sort
univSort Maybe Sort
ui (Sort -> Sort) -> ReduceM Sort -> ReduceM Sort
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sort -> ReduceM Sort
forall t. Simplify t => t -> ReduceM t
simplify' Sort
s
Type s :: Level
s -> Level -> Sort
forall t. Level' t -> Sort' t
Type (Level -> Sort) -> ReduceM Level -> ReduceM Sort
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Level -> ReduceM Level
forall t. Simplify t => t -> ReduceM t
simplify' Level
s
Prop s :: Level
s -> Level -> Sort
forall t. Level' t -> Sort' t
Prop (Level -> Sort) -> ReduceM Level -> ReduceM Sort
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Level -> ReduceM Level
forall t. Simplify t => t -> ReduceM t
simplify' Level
s
Inf -> Sort -> ReduceM Sort
forall (m :: * -> *) a. Monad m => a -> m a
return Sort
s
SizeUniv -> Sort -> ReduceM Sort
forall (m :: * -> *) a. Monad m => a -> m a
return Sort
s
MetaS x :: MetaId
x es :: Elims
es -> MetaId -> Elims -> Sort
forall t. MetaId -> [Elim' t] -> Sort' t
MetaS MetaId
x (Elims -> Sort) -> ReduceM Elims -> ReduceM Sort
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Elims -> ReduceM Elims
forall t. Simplify t => t -> ReduceM t
simplify' Elims
es
DefS d :: QName
d es :: Elims
es -> QName -> Elims -> Sort
forall t. QName -> [Elim' t] -> Sort' t
DefS QName
d (Elims -> Sort) -> ReduceM Elims -> ReduceM Sort
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Elims -> ReduceM Elims
forall t. Simplify t => t -> ReduceM t
simplify' Elims
es
DummyS{} -> Sort -> ReduceM Sort
forall (m :: * -> *) a. Monad m => a -> m a
return Sort
s
instance Simplify Level where
simplify' :: Level -> ReduceM Level
simplify' (Max m :: Integer
m as :: [PlusLevel' Term]
as) = Integer -> [PlusLevel' Term] -> Level
levelMax Integer
m ([PlusLevel' Term] -> Level)
-> ReduceM [PlusLevel' Term] -> ReduceM Level
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [PlusLevel' Term] -> ReduceM [PlusLevel' Term]
forall t. Simplify t => t -> ReduceM t
simplify' [PlusLevel' Term]
as
instance Simplify PlusLevel where
simplify' :: PlusLevel' Term -> ReduceM (PlusLevel' Term)
simplify' (Plus n :: Integer
n l :: LevelAtom' Term
l) = Integer -> LevelAtom' Term -> PlusLevel' Term
forall t. Integer -> LevelAtom' t -> PlusLevel' t
Plus Integer
n (LevelAtom' Term -> PlusLevel' Term)
-> ReduceM (LevelAtom' Term) -> ReduceM (PlusLevel' Term)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LevelAtom' Term -> ReduceM (LevelAtom' Term)
forall t. Simplify t => t -> ReduceM t
simplify' LevelAtom' Term
l
instance Simplify LevelAtom where
simplify' :: LevelAtom' Term -> ReduceM (LevelAtom' Term)
simplify' l :: LevelAtom' Term
l = do
LevelAtom' Term
l <- LevelAtom' Term -> ReduceM (LevelAtom' Term)
forall t. Instantiate t => t -> ReduceM t
instantiate' LevelAtom' Term
l
case LevelAtom' Term
l of
MetaLevel m :: MetaId
m vs :: Elims
vs -> MetaId -> Elims -> LevelAtom' Term
forall t. MetaId -> [Elim' t] -> LevelAtom' t
MetaLevel MetaId
m (Elims -> LevelAtom' Term)
-> ReduceM Elims -> ReduceM (LevelAtom' Term)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Elims -> ReduceM Elims
forall t. Simplify t => t -> ReduceM t
simplify' Elims
vs
BlockedLevel m :: MetaId
m v :: Term
v -> MetaId -> Term -> LevelAtom' Term
forall t. MetaId -> t -> LevelAtom' t
BlockedLevel MetaId
m (Term -> LevelAtom' Term)
-> ReduceM Term -> ReduceM (LevelAtom' Term)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term -> ReduceM Term
forall t. Simplify t => t -> ReduceM t
simplify' Term
v
NeutralLevel r :: NotBlocked
r v :: Term
v -> NotBlocked -> Term -> LevelAtom' Term
forall t. NotBlocked -> t -> LevelAtom' t
NeutralLevel NotBlocked
r (Term -> LevelAtom' Term)
-> ReduceM Term -> ReduceM (LevelAtom' Term)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term -> ReduceM Term
forall t. Simplify t => t -> ReduceM t
simplify' Term
v
UnreducedLevel v :: Term
v -> Term -> LevelAtom' Term
forall t. t -> LevelAtom' t
UnreducedLevel (Term -> LevelAtom' Term)
-> ReduceM Term -> ReduceM (LevelAtom' Term)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term -> ReduceM Term
forall t. Simplify t => t -> ReduceM t
simplify' Term
v
instance (Subst t a, Simplify a) => Simplify (Abs a) where
simplify' :: Abs a -> ReduceM (Abs a)
simplify' a :: Abs a
a@(Abs x :: String
x _) = String -> a -> Abs a
forall a. String -> a -> Abs a
Abs String
x (a -> Abs a) -> ReduceM a -> ReduceM (Abs a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Abs a -> (a -> ReduceM a) -> ReduceM a
forall t a (m :: * -> *) b.
(Subst t a, MonadAddContext m) =>
Abs a -> (a -> m b) -> m b
underAbstraction_ Abs a
a a -> ReduceM a
forall t. Simplify t => t -> ReduceM t
simplify'
simplify' (NoAbs x :: String
x v :: a
v) = String -> a -> Abs a
forall a. String -> a -> Abs a
NoAbs String
x (a -> Abs a) -> ReduceM a -> ReduceM (Abs a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> ReduceM a
forall t. Simplify t => t -> ReduceM t
simplify' a
v
instance Simplify t => Simplify (Dom t) where
simplify' :: Dom t -> ReduceM (Dom t)
simplify' = (t -> ReduceM t) -> Dom t -> ReduceM (Dom t)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse t -> ReduceM t
forall t. Simplify t => t -> ReduceM t
simplify'
instance Simplify a => Simplify (Closure a) where
simplify' :: Closure a -> ReduceM (Closure a)
simplify' cl :: Closure a
cl = do
a
x <- Closure a -> (a -> ReduceM a) -> ReduceM a
forall a c b. LensClosure a c => c -> (a -> ReduceM b) -> ReduceM b
enterClosure Closure a
cl a -> ReduceM a
forall t. Simplify t => t -> ReduceM t
simplify'
Closure a -> ReduceM (Closure a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Closure a -> ReduceM (Closure a))
-> Closure a -> ReduceM (Closure a)
forall a b. (a -> b) -> a -> b
$ Closure a
cl { clValue :: a
clValue = a
x }
instance (Subst t a, Simplify a) => Simplify (Tele a) where
simplify' :: Tele a -> ReduceM (Tele a)
simplify' EmptyTel = Tele a -> ReduceM (Tele a)
forall (m :: * -> *) a. Monad m => a -> m a
return Tele a
forall a. Tele a
EmptyTel
simplify' (ExtendTel a :: a
a b :: Abs (Tele a)
b) = (a -> Abs (Tele a) -> Tele a) -> (a, Abs (Tele a)) -> Tele a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry a -> Abs (Tele a) -> Tele a
forall a. a -> Abs (Tele a) -> Tele a
ExtendTel ((a, Abs (Tele a)) -> Tele a)
-> ReduceM (a, Abs (Tele a)) -> ReduceM (Tele a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a, Abs (Tele a)) -> ReduceM (a, Abs (Tele a))
forall t. Simplify t => t -> ReduceM t
simplify' (a
a, Abs (Tele a)
b)
instance Simplify ProblemConstraint where
simplify' :: ProblemConstraint -> ReduceM ProblemConstraint
simplify' (PConstr pid :: Set ProblemId
pid c :: Closure Constraint
c) = Set ProblemId -> Closure Constraint -> ProblemConstraint
PConstr Set ProblemId
pid (Closure Constraint -> ProblemConstraint)
-> ReduceM (Closure Constraint) -> ReduceM ProblemConstraint
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Closure Constraint -> ReduceM (Closure Constraint)
forall t. Simplify t => t -> ReduceM t
simplify' Closure Constraint
c
instance Simplify Constraint where
simplify' :: Constraint -> ReduceM Constraint
simplify' (ValueCmp cmp :: Comparison
cmp t :: CompareAs
t u :: Term
u v :: Term
v) = do
(t :: CompareAs
t,u :: Term
u,v :: Term
v) <- (CompareAs, Term, Term) -> ReduceM (CompareAs, Term, Term)
forall t. Simplify t => t -> ReduceM t
simplify' (CompareAs
t,Term
u,Term
v)
Constraint -> ReduceM Constraint
forall (m :: * -> *) a. Monad m => a -> m a
return (Constraint -> ReduceM Constraint)
-> Constraint -> ReduceM Constraint
forall a b. (a -> b) -> a -> b
$ Comparison -> CompareAs -> Term -> Term -> Constraint
ValueCmp Comparison
cmp CompareAs
t Term
u Term
v
simplify' (ValueCmpOnFace cmp :: Comparison
cmp p :: Term
p t :: Type
t u :: Term
u v :: Term
v) = do
((p :: Term
p,t :: Type
t),u :: Term
u,v :: Term
v) <- ((Term, Type), Term, Term) -> ReduceM ((Term, Type), Term, Term)
forall t. Simplify t => t -> ReduceM t
simplify' ((Term
p,Type
t),Term
u,Term
v)
Constraint -> ReduceM Constraint
forall (m :: * -> *) a. Monad m => a -> m a
return (Constraint -> ReduceM Constraint)
-> Constraint -> ReduceM Constraint
forall a b. (a -> b) -> a -> b
$ Comparison -> CompareAs -> Term -> Term -> Constraint
ValueCmp Comparison
cmp (Type -> CompareAs
AsTermsOf Type
t) Term
u Term
v
simplify' (ElimCmp cmp :: [Polarity]
cmp fs :: [IsForced]
fs t :: Type
t v :: Term
v as :: Elims
as bs :: Elims
bs) =
[Polarity]
-> [IsForced] -> Type -> Term -> Elims -> Elims -> Constraint
ElimCmp [Polarity]
cmp [IsForced]
fs (Type -> Term -> Elims -> Elims -> Constraint)
-> ReduceM Type -> ReduceM (Term -> Elims -> Elims -> Constraint)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Type -> ReduceM Type
forall t. Simplify t => t -> ReduceM t
simplify' Type
t ReduceM (Term -> Elims -> Elims -> Constraint)
-> ReduceM Term -> ReduceM (Elims -> Elims -> Constraint)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Term -> ReduceM Term
forall t. Simplify t => t -> ReduceM t
simplify' Term
v ReduceM (Elims -> Elims -> Constraint)
-> ReduceM Elims -> ReduceM (Elims -> Constraint)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Elims -> ReduceM Elims
forall t. Simplify t => t -> ReduceM t
simplify' Elims
as ReduceM (Elims -> Constraint)
-> ReduceM Elims -> ReduceM Constraint
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Elims -> ReduceM Elims
forall t. Simplify t => t -> ReduceM t
simplify' Elims
bs
simplify' (LevelCmp cmp :: Comparison
cmp u :: Level
u v :: Level
v) = (Level -> Level -> Constraint) -> (Level, Level) -> Constraint
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (Comparison -> Level -> Level -> Constraint
LevelCmp Comparison
cmp) ((Level, Level) -> Constraint)
-> ReduceM (Level, Level) -> ReduceM Constraint
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Level, Level) -> ReduceM (Level, Level)
forall t. Simplify t => t -> ReduceM t
simplify' (Level
u,Level
v)
simplify' (TelCmp a :: Type
a b :: Type
b cmp :: Comparison
cmp tela :: Telescope
tela telb :: Telescope
telb) = (Telescope -> Telescope -> Constraint)
-> (Telescope, Telescope) -> Constraint
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (Type -> Type -> Comparison -> Telescope -> Telescope -> Constraint
TelCmp Type
a Type
b Comparison
cmp) ((Telescope, Telescope) -> Constraint)
-> ReduceM (Telescope, Telescope) -> ReduceM Constraint
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Telescope, Telescope) -> ReduceM (Telescope, Telescope)
forall t. Simplify t => t -> ReduceM t
simplify' (Telescope
tela,Telescope
telb)
simplify' (SortCmp cmp :: Comparison
cmp a :: Sort
a b :: Sort
b) = (Sort -> Sort -> Constraint) -> (Sort, Sort) -> Constraint
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (Comparison -> Sort -> Sort -> Constraint
SortCmp Comparison
cmp) ((Sort, Sort) -> Constraint)
-> ReduceM (Sort, Sort) -> ReduceM Constraint
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Sort, Sort) -> ReduceM (Sort, Sort)
forall t. Simplify t => t -> ReduceM t
simplify' (Sort
a,Sort
b)
simplify' (Guarded c :: Constraint
c pid :: ProblemId
pid) = Constraint -> ProblemId -> Constraint
Guarded (Constraint -> ProblemId -> Constraint)
-> ReduceM Constraint -> ReduceM (ProblemId -> Constraint)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Constraint -> ReduceM Constraint
forall t. Simplify t => t -> ReduceM t
simplify' Constraint
c ReduceM (ProblemId -> Constraint)
-> ReduceM ProblemId -> ReduceM Constraint
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ProblemId -> ReduceM ProblemId
forall (f :: * -> *) a. Applicative f => a -> f a
pure ProblemId
pid
simplify' (UnBlock m :: MetaId
m) = Constraint -> ReduceM Constraint
forall (m :: * -> *) a. Monad m => a -> m a
return (Constraint -> ReduceM Constraint)
-> Constraint -> ReduceM Constraint
forall a b. (a -> b) -> a -> b
$ MetaId -> Constraint
UnBlock MetaId
m
simplify' (FindInstance m :: MetaId
m b :: Maybe MetaId
b cands :: Maybe [Candidate]
cands) = MetaId -> Maybe MetaId -> Maybe [Candidate] -> Constraint
FindInstance MetaId
m Maybe MetaId
b (Maybe [Candidate] -> Constraint)
-> ReduceM (Maybe [Candidate]) -> ReduceM Constraint
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Candidate] -> ReduceM [Candidate])
-> Maybe [Candidate] -> ReduceM (Maybe [Candidate])
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM [Candidate] -> ReduceM [Candidate]
forall t. Simplify t => t -> ReduceM t
simplify' Maybe [Candidate]
cands
simplify' (IsEmpty r :: Range
r t :: Type
t) = Range -> Type -> Constraint
IsEmpty Range
r (Type -> Constraint) -> ReduceM Type -> ReduceM Constraint
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Type -> ReduceM Type
forall t. Simplify t => t -> ReduceM t
simplify' Type
t
simplify' (CheckSizeLtSat t :: Term
t) = Term -> Constraint
CheckSizeLtSat (Term -> Constraint) -> ReduceM Term -> ReduceM Constraint
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term -> ReduceM Term
forall t. Simplify t => t -> ReduceM t
simplify' Term
t
simplify' c :: Constraint
c@CheckFunDef{} = Constraint -> ReduceM Constraint
forall (m :: * -> *) a. Monad m => a -> m a
return Constraint
c
simplify' (HasBiggerSort a :: Sort
a) = Sort -> Constraint
HasBiggerSort (Sort -> Constraint) -> ReduceM Sort -> ReduceM Constraint
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sort -> ReduceM Sort
forall t. Simplify t => t -> ReduceM t
simplify' Sort
a
simplify' (HasPTSRule a :: Dom Type
a b :: Abs Sort
b) = (Dom Type -> Abs Sort -> Constraint)
-> (Dom Type, Abs Sort) -> Constraint
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Dom Type -> Abs Sort -> Constraint
HasPTSRule ((Dom Type, Abs Sort) -> Constraint)
-> ReduceM (Dom Type, Abs Sort) -> ReduceM Constraint
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Dom Type, Abs Sort) -> ReduceM (Dom Type, Abs Sort)
forall t. Simplify t => t -> ReduceM t
simplify' (Dom Type
a,Abs Sort
b)
simplify' (UnquoteTactic m :: Maybe MetaId
m t :: Term
t h :: Term
h g :: Type
g) = Maybe MetaId -> Term -> Term -> Type -> Constraint
UnquoteTactic Maybe MetaId
m (Term -> Term -> Type -> Constraint)
-> ReduceM Term -> ReduceM (Term -> Type -> Constraint)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term -> ReduceM Term
forall t. Simplify t => t -> ReduceM t
simplify' Term
t ReduceM (Term -> Type -> Constraint)
-> ReduceM Term -> ReduceM (Type -> Constraint)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Term -> ReduceM Term
forall t. Simplify t => t -> ReduceM t
simplify' Term
h ReduceM (Type -> Constraint) -> ReduceM Type -> ReduceM Constraint
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Type -> ReduceM Type
forall t. Simplify t => t -> ReduceM t
simplify' Type
g
simplify' c :: Constraint
c@CheckMetaInst{} = Constraint -> ReduceM Constraint
forall (m :: * -> *) a. Monad m => a -> m a
return Constraint
c
instance Simplify CompareAs where
simplify' :: CompareAs -> ReduceM CompareAs
simplify' (AsTermsOf a :: Type
a) = Type -> CompareAs
AsTermsOf (Type -> CompareAs) -> ReduceM Type -> ReduceM CompareAs
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Type -> ReduceM Type
forall t. Simplify t => t -> ReduceM t
simplify' Type
a
simplify' AsSizes = CompareAs -> ReduceM CompareAs
forall (m :: * -> *) a. Monad m => a -> m a
return CompareAs
AsSizes
simplify' AsTypes = CompareAs -> ReduceM CompareAs
forall (m :: * -> *) a. Monad m => a -> m a
return CompareAs
AsTypes
instance Simplify DisplayForm where
simplify' :: DisplayForm -> ReduceM DisplayForm
simplify' (Display n :: Int
n ps :: Elims
ps v :: DisplayTerm
v) = Int -> Elims -> DisplayTerm -> DisplayForm
Display Int
n (Elims -> DisplayTerm -> DisplayForm)
-> ReduceM Elims -> ReduceM (DisplayTerm -> DisplayForm)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Elims -> ReduceM Elims
forall t. Simplify t => t -> ReduceM t
simplify' Elims
ps ReduceM (DisplayTerm -> DisplayForm)
-> ReduceM DisplayTerm -> ReduceM DisplayForm
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> DisplayTerm -> ReduceM DisplayTerm
forall (m :: * -> *) a. Monad m => a -> m a
return DisplayTerm
v
instance Simplify Candidate where
simplify' :: Candidate -> ReduceM Candidate
simplify' (Candidate u :: Term
u t :: Type
t ov :: Bool
ov) = Term -> Type -> Bool -> Candidate
Candidate (Term -> Type -> Bool -> Candidate)
-> ReduceM Term -> ReduceM (Type -> Bool -> Candidate)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term -> ReduceM Term
forall t. Simplify t => t -> ReduceM t
simplify' Term
u ReduceM (Type -> Bool -> Candidate)
-> ReduceM Type -> ReduceM (Bool -> Candidate)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Type -> ReduceM Type
forall t. Simplify t => t -> ReduceM t
simplify' Type
t ReduceM (Bool -> Candidate) -> ReduceM Bool -> ReduceM Candidate
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Bool -> ReduceM Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
ov
instance Simplify EqualityView where
simplify' :: EqualityView -> ReduceM EqualityView
simplify' (OtherType t :: Type
t) = Type -> EqualityView
OtherType
(Type -> EqualityView) -> ReduceM Type -> ReduceM EqualityView
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Type -> ReduceM Type
forall t. Simplify t => t -> ReduceM t
simplify' Type
t
simplify' (EqualityType s :: Sort
s eq :: QName
eq l :: [Arg Term]
l t :: Arg Term
t a :: Arg Term
a b :: Arg Term
b) = Sort
-> QName
-> [Arg Term]
-> Arg Term
-> Arg Term
-> Arg Term
-> EqualityView
EqualityType
(Sort
-> QName
-> [Arg Term]
-> Arg Term
-> Arg Term
-> Arg Term
-> EqualityView)
-> ReduceM Sort
-> ReduceM
(QName
-> [Arg Term] -> Arg Term -> Arg Term -> Arg Term -> EqualityView)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sort -> ReduceM Sort
forall t. Simplify t => t -> ReduceM t
simplify' Sort
s
ReduceM
(QName
-> [Arg Term] -> Arg Term -> Arg Term -> Arg Term -> EqualityView)
-> ReduceM QName
-> ReduceM
([Arg Term] -> Arg Term -> Arg Term -> Arg Term -> EqualityView)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> QName -> ReduceM QName
forall (m :: * -> *) a. Monad m => a -> m a
return QName
eq
ReduceM
([Arg Term] -> Arg Term -> Arg Term -> Arg Term -> EqualityView)
-> ReduceM [Arg Term]
-> ReduceM (Arg Term -> Arg Term -> Arg Term -> EqualityView)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Arg Term -> ReduceM (Arg Term))
-> [Arg Term] -> ReduceM [Arg Term]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Arg Term -> ReduceM (Arg Term)
forall t. Simplify t => t -> ReduceM t
simplify' [Arg Term]
l
ReduceM (Arg Term -> Arg Term -> Arg Term -> EqualityView)
-> ReduceM (Arg Term)
-> ReduceM (Arg Term -> Arg Term -> EqualityView)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Arg Term -> ReduceM (Arg Term)
forall t. Simplify t => t -> ReduceM t
simplify' Arg Term
t
ReduceM (Arg Term -> Arg Term -> EqualityView)
-> ReduceM (Arg Term) -> ReduceM (Arg Term -> EqualityView)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Arg Term -> ReduceM (Arg Term)
forall t. Simplify t => t -> ReduceM t
simplify' Arg Term
a
ReduceM (Arg Term -> EqualityView)
-> ReduceM (Arg Term) -> ReduceM EqualityView
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Arg Term -> ReduceM (Arg Term)
forall t. Simplify t => t -> ReduceM t
simplify' Arg Term
b
class Normalise t where
normalise' :: t -> ReduceM t
default normalise' :: (t ~ f a, Traversable f, Normalise a) => t -> ReduceM t
normalise' = (a -> ReduceM a) -> f a -> ReduceM (f a)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> ReduceM a
forall t. Normalise t => t -> ReduceM t
normalise'
instance Normalise t => Normalise [t]
instance Normalise t => Normalise (Map k t)
instance Normalise t => Normalise (Maybe t)
instance Normalise t => Normalise (Strict.Maybe t)
instance Normalise t => Normalise (Named name t)
instance Normalise t => Normalise (IPBoundary' t)
instance Normalise t => Normalise (WithHiding t)
instance (Normalise a, Normalise b) => Normalise (a,b) where
normalise' :: (a, b) -> ReduceM (a, b)
normalise' (x :: a
x,y :: b
y) = (,) (a -> b -> (a, b)) -> ReduceM a -> ReduceM (b -> (a, b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> ReduceM a
forall t. Normalise t => t -> ReduceM t
normalise' a
x ReduceM (b -> (a, b)) -> ReduceM b -> ReduceM (a, b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> b -> ReduceM b
forall t. Normalise t => t -> ReduceM t
normalise' b
y
instance (Normalise a, Normalise b, Normalise c) => Normalise (a,b,c) where
normalise' :: (a, b, c) -> ReduceM (a, b, c)
normalise' (x :: a
x,y :: b
y,z :: c
z) =
do (x :: a
x,(y :: b
y,z :: c
z)) <- (a, (b, c)) -> ReduceM (a, (b, c))
forall t. Normalise t => t -> ReduceM t
normalise' (a
x,(b
y,c
z))
(a, b, c) -> ReduceM (a, b, c)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
x,b
y,c
z)
instance Normalise Bool where
normalise' :: Bool -> ReduceM Bool
normalise' = Bool -> ReduceM Bool
forall (m :: * -> *) a. Monad m => a -> m a
return
instance Normalise Char where
normalise' :: Char -> ReduceM Char
normalise' = Char -> ReduceM Char
forall (m :: * -> *) a. Monad m => a -> m a
return
instance Normalise Int where
normalise' :: Int -> ReduceM Int
normalise' = Int -> ReduceM Int
forall (m :: * -> *) a. Monad m => a -> m a
return
instance Normalise DBPatVar where
normalise' :: DBPatVar -> ReduceM DBPatVar
normalise' = DBPatVar -> ReduceM DBPatVar
forall (m :: * -> *) a. Monad m => a -> m a
return
instance Normalise Sort where
normalise' :: Sort -> ReduceM Sort
normalise' s :: Sort
s = do
Sort
s <- Sort -> ReduceM Sort
forall t. Reduce t => t -> ReduceM t
reduce' Sort
s
case Sort
s of
PiSort a :: Dom Type
a s :: Abs Sort
s -> Dom Type -> Abs Sort -> Sort
piSort (Dom Type -> Abs Sort -> Sort)
-> ReduceM (Dom Type) -> ReduceM (Abs Sort -> Sort)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Dom Type -> ReduceM (Dom Type)
forall t. Normalise t => t -> ReduceM t
normalise' Dom Type
a ReduceM (Abs Sort -> Sort) -> ReduceM (Abs Sort) -> ReduceM Sort
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Abs Sort -> ReduceM (Abs Sort)
forall t. Normalise t => t -> ReduceM t
normalise' Abs Sort
s
FunSort s1 :: Sort
s1 s2 :: Sort
s2 -> Sort -> Sort -> Sort
funSort (Sort -> Sort -> Sort) -> ReduceM Sort -> ReduceM (Sort -> Sort)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sort -> ReduceM Sort
forall t. Normalise t => t -> ReduceM t
normalise' Sort
s1 ReduceM (Sort -> Sort) -> ReduceM Sort -> ReduceM Sort
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Sort -> ReduceM Sort
forall t. Normalise t => t -> ReduceM t
normalise' Sort
s2
UnivSort s :: Sort
s -> do
Maybe Sort
ui <- ReduceM (Maybe Sort)
forall (m :: * -> *). HasOptions m => m (Maybe Sort)
univInf
Maybe Sort -> Sort -> Sort
univSort Maybe Sort
ui (Sort -> Sort) -> ReduceM Sort -> ReduceM Sort
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sort -> ReduceM Sort
forall t. Normalise t => t -> ReduceM t
normalise' Sort
s
Prop s :: Level
s -> Level -> Sort
forall t. Level' t -> Sort' t
Prop (Level -> Sort) -> ReduceM Level -> ReduceM Sort
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Level -> ReduceM Level
forall t. Normalise t => t -> ReduceM t
normalise' Level
s
Type s :: Level
s -> Level -> Sort
forall t. Level' t -> Sort' t
Type (Level -> Sort) -> ReduceM Level -> ReduceM Sort
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Level -> ReduceM Level
forall t. Normalise t => t -> ReduceM t
normalise' Level
s
Inf -> Sort -> ReduceM Sort
forall (m :: * -> *) a. Monad m => a -> m a
return Sort
forall t. Sort' t
Inf
SizeUniv -> Sort -> ReduceM Sort
forall (m :: * -> *) a. Monad m => a -> m a
return Sort
forall t. Sort' t
SizeUniv
MetaS x :: MetaId
x es :: Elims
es -> Sort -> ReduceM Sort
forall (m :: * -> *) a. Monad m => a -> m a
return Sort
s
DefS d :: QName
d es :: Elims
es -> Sort -> ReduceM Sort
forall (m :: * -> *) a. Monad m => a -> m a
return Sort
s
DummyS{} -> Sort -> ReduceM Sort
forall (m :: * -> *) a. Monad m => a -> m a
return Sort
s
instance Normalise t => Normalise (Type' t) where
normalise' :: Type' t -> ReduceM (Type' t)
normalise' (El s :: Sort
s t :: t
t) = Sort -> t -> Type' t
forall t a. Sort' t -> a -> Type'' t a
El (Sort -> t -> Type' t) -> ReduceM Sort -> ReduceM (t -> Type' t)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sort -> ReduceM Sort
forall t. Normalise t => t -> ReduceM t
normalise' Sort
s ReduceM (t -> Type' t) -> ReduceM t -> ReduceM (Type' t)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> t -> ReduceM t
forall t. Normalise t => t -> ReduceM t
normalise' t
t
instance Normalise Term where
normalise' :: Term -> ReduceM Term
normalise' v :: Term
v = ReduceM Bool -> ReduceM Term -> ReduceM Term -> ReduceM Term
forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifM ReduceM Bool
shouldTryFastReduce (Term -> ReduceM Term
fastNormalise Term
v) (Term -> ReduceM Term
slowNormaliseArgs (Term -> ReduceM Term) -> ReduceM Term -> ReduceM Term
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
v)
slowNormaliseArgs :: Term -> ReduceM Term
slowNormaliseArgs :: Term -> ReduceM Term
slowNormaliseArgs v :: Term
v = case Term
v of
Var n :: Int
n vs :: Elims
vs -> Int -> Elims -> Term
Var Int
n (Elims -> Term) -> ReduceM Elims -> ReduceM Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Elims -> ReduceM Elims
forall t. Normalise t => t -> ReduceM t
normalise' Elims
vs
Con c :: ConHead
c ci :: ConInfo
ci vs :: Elims
vs -> ConHead -> ConInfo -> Elims -> Term
Con ConHead
c ConInfo
ci (Elims -> Term) -> ReduceM Elims -> ReduceM Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Elims -> ReduceM Elims
forall t. Normalise t => t -> ReduceM t
normalise' Elims
vs
Def f :: QName
f vs :: Elims
vs -> QName -> Elims -> Term
Def QName
f (Elims -> Term) -> ReduceM Elims -> ReduceM Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Elims -> ReduceM Elims
forall t. Normalise t => t -> ReduceM t
normalise' Elims
vs
MetaV x :: MetaId
x vs :: Elims
vs -> MetaId -> Elims -> Term
MetaV MetaId
x (Elims -> Term) -> ReduceM Elims -> ReduceM Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Elims -> ReduceM Elims
forall t. Normalise t => t -> ReduceM t
normalise' Elims
vs
Lit _ -> Term -> ReduceM Term
forall (m :: * -> *) a. Monad m => a -> m a
return Term
v
Level l :: Level
l -> Level -> Term
levelTm (Level -> Term) -> ReduceM Level -> ReduceM Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Level -> ReduceM Level
forall t. Normalise t => t -> ReduceM t
normalise' Level
l
Lam h :: ArgInfo
h b :: Abs Term
b -> ArgInfo -> Abs Term -> Term
Lam ArgInfo
h (Abs Term -> Term) -> ReduceM (Abs Term) -> ReduceM Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Abs Term -> ReduceM (Abs Term)
forall t. Normalise t => t -> ReduceM t
normalise' Abs Term
b
Sort s :: Sort
s -> Sort -> Term
Sort (Sort -> Term) -> ReduceM Sort -> ReduceM Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sort -> ReduceM Sort
forall t. Normalise t => t -> ReduceM t
normalise' Sort
s
Pi a :: Dom Type
a b :: Abs Type
b -> (Dom Type -> Abs Type -> Term) -> (Dom Type, Abs Type) -> Term
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Dom Type -> Abs Type -> Term
Pi ((Dom Type, Abs Type) -> Term)
-> ReduceM (Dom Type, Abs Type) -> ReduceM Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Dom Type, Abs Type) -> ReduceM (Dom Type, Abs Type)
forall t. Normalise t => t -> ReduceM t
normalise' (Dom Type
a, Abs Type
b)
DontCare _ -> Term -> ReduceM Term
forall (m :: * -> *) a. Monad m => a -> m a
return Term
v
Dummy{} -> Term -> ReduceM Term
forall (m :: * -> *) a. Monad m => a -> m a
return Term
v
instance Normalise t => Normalise (Elim' t) where
normalise' :: Elim' t -> ReduceM (Elim' t)
normalise' (Apply v :: Arg t
v) = Arg t -> Elim' t
forall a. Arg a -> Elim' a
Apply (Arg t -> Elim' t) -> ReduceM (Arg t) -> ReduceM (Elim' t)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Arg t -> ReduceM (Arg t)
forall t. Normalise t => t -> ReduceM t
normalise' Arg t
v
normalise' (Proj o :: ProjOrigin
o f :: QName
f)= Elim' t -> ReduceM (Elim' t)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Elim' t -> ReduceM (Elim' t)) -> Elim' t -> ReduceM (Elim' t)
forall a b. (a -> b) -> a -> b
$ ProjOrigin -> QName -> Elim' t
forall a. ProjOrigin -> QName -> Elim' a
Proj ProjOrigin
o QName
f
normalise' (IApply x :: t
x y :: t
y v :: t
v) = t -> t -> t -> Elim' t
forall a. a -> a -> a -> Elim' a
IApply (t -> t -> t -> Elim' t)
-> ReduceM t -> ReduceM (t -> t -> Elim' t)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> t -> ReduceM t
forall t. Normalise t => t -> ReduceM t
normalise' t
x ReduceM (t -> t -> Elim' t) -> ReduceM t -> ReduceM (t -> Elim' t)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> t -> ReduceM t
forall t. Normalise t => t -> ReduceM t
normalise' t
y ReduceM (t -> Elim' t) -> ReduceM t -> ReduceM (Elim' t)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> t -> ReduceM t
forall t. Normalise t => t -> ReduceM t
normalise' t
v
instance Normalise Level where
normalise' :: Level -> ReduceM Level
normalise' (Max m :: Integer
m as :: [PlusLevel' Term]
as) = Integer -> [PlusLevel' Term] -> Level
levelMax Integer
m ([PlusLevel' Term] -> Level)
-> ReduceM [PlusLevel' Term] -> ReduceM Level
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [PlusLevel' Term] -> ReduceM [PlusLevel' Term]
forall t. Normalise t => t -> ReduceM t
normalise' [PlusLevel' Term]
as
instance Normalise PlusLevel where
normalise' :: PlusLevel' Term -> ReduceM (PlusLevel' Term)
normalise' (Plus n :: Integer
n l :: LevelAtom' Term
l) = Integer -> LevelAtom' Term -> PlusLevel' Term
forall t. Integer -> LevelAtom' t -> PlusLevel' t
Plus Integer
n (LevelAtom' Term -> PlusLevel' Term)
-> ReduceM (LevelAtom' Term) -> ReduceM (PlusLevel' Term)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LevelAtom' Term -> ReduceM (LevelAtom' Term)
forall t. Normalise t => t -> ReduceM t
normalise' LevelAtom' Term
l
instance Normalise LevelAtom where
normalise' :: LevelAtom' Term -> ReduceM (LevelAtom' Term)
normalise' l :: LevelAtom' Term
l = do
LevelAtom' Term
l <- LevelAtom' Term -> ReduceM (LevelAtom' Term)
forall t. Reduce t => t -> ReduceM t
reduce' LevelAtom' Term
l
case LevelAtom' Term
l of
MetaLevel m :: MetaId
m vs :: Elims
vs -> MetaId -> Elims -> LevelAtom' Term
forall t. MetaId -> [Elim' t] -> LevelAtom' t
MetaLevel MetaId
m (Elims -> LevelAtom' Term)
-> ReduceM Elims -> ReduceM (LevelAtom' Term)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Elims -> ReduceM Elims
forall t. Normalise t => t -> ReduceM t
normalise' Elims
vs
BlockedLevel m :: MetaId
m v :: Term
v -> MetaId -> Term -> LevelAtom' Term
forall t. MetaId -> t -> LevelAtom' t
BlockedLevel MetaId
m (Term -> LevelAtom' Term)
-> ReduceM Term -> ReduceM (LevelAtom' Term)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term -> ReduceM Term
forall t. Normalise t => t -> ReduceM t
normalise' Term
v
NeutralLevel r :: NotBlocked
r v :: Term
v -> NotBlocked -> Term -> LevelAtom' Term
forall t. NotBlocked -> t -> LevelAtom' t
NeutralLevel NotBlocked
r (Term -> LevelAtom' Term)
-> ReduceM Term -> ReduceM (LevelAtom' Term)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term -> ReduceM Term
forall t. Normalise t => t -> ReduceM t
normalise' Term
v
UnreducedLevel{} -> ReduceM (LevelAtom' Term)
forall a. HasCallStack => a
__IMPOSSIBLE__
instance (Subst t a, Normalise a) => Normalise (Abs a) where
normalise' :: Abs a -> ReduceM (Abs a)
normalise' a :: Abs a
a@(Abs x :: String
x _) = String -> a -> Abs a
forall a. String -> a -> Abs a
Abs String
x (a -> Abs a) -> ReduceM a -> ReduceM (Abs a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Abs a -> (a -> ReduceM a) -> ReduceM a
forall t a (m :: * -> *) b.
(Subst t a, MonadAddContext m) =>
Abs a -> (a -> m b) -> m b
underAbstraction_ Abs a
a a -> ReduceM a
forall t. Normalise t => t -> ReduceM t
normalise'
normalise' (NoAbs x :: String
x v :: a
v) = String -> a -> Abs a
forall a. String -> a -> Abs a
NoAbs String
x (a -> Abs a) -> ReduceM a -> ReduceM (Abs a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> ReduceM a
forall t. Normalise t => t -> ReduceM t
normalise' a
v
instance Normalise t => Normalise (Arg t) where
normalise' :: Arg t -> ReduceM (Arg t)
normalise' a :: Arg t
a
| Arg t -> Bool
forall a. LensRelevance a => a -> Bool
isIrrelevant Arg t
a = Arg t -> ReduceM (Arg t)
forall (m :: * -> *) a. Monad m => a -> m a
return Arg t
a
| Bool
otherwise = (t -> ReduceM t) -> Arg t -> ReduceM (Arg t)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse t -> ReduceM t
forall t. Normalise t => t -> ReduceM t
normalise' Arg t
a
instance Normalise t => Normalise (Dom t) where
normalise' :: Dom t -> ReduceM (Dom t)
normalise' = (t -> ReduceM t) -> Dom t -> ReduceM (Dom t)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse t -> ReduceM t
forall t. Normalise t => t -> ReduceM t
normalise'
instance Normalise a => Normalise (Closure a) where
normalise' :: Closure a -> ReduceM (Closure a)
normalise' cl :: Closure a
cl = do
a
x <- Closure a -> (a -> ReduceM a) -> ReduceM a
forall a c b. LensClosure a c => c -> (a -> ReduceM b) -> ReduceM b
enterClosure Closure a
cl a -> ReduceM a
forall t. Normalise t => t -> ReduceM t
normalise'
Closure a -> ReduceM (Closure a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Closure a -> ReduceM (Closure a))
-> Closure a -> ReduceM (Closure a)
forall a b. (a -> b) -> a -> b
$ Closure a
cl { clValue :: a
clValue = a
x }
instance (Subst t a, Normalise a) => Normalise (Tele a) where
normalise' :: Tele a -> ReduceM (Tele a)
normalise' EmptyTel = Tele a -> ReduceM (Tele a)
forall (m :: * -> *) a. Monad m => a -> m a
return Tele a
forall a. Tele a
EmptyTel
normalise' (ExtendTel a :: a
a b :: Abs (Tele a)
b) = (a -> Abs (Tele a) -> Tele a) -> (a, Abs (Tele a)) -> Tele a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry a -> Abs (Tele a) -> Tele a
forall a. a -> Abs (Tele a) -> Tele a
ExtendTel ((a, Abs (Tele a)) -> Tele a)
-> ReduceM (a, Abs (Tele a)) -> ReduceM (Tele a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a, Abs (Tele a)) -> ReduceM (a, Abs (Tele a))
forall t. Normalise t => t -> ReduceM t
normalise' (a
a, Abs (Tele a)
b)
instance Normalise ProblemConstraint where
normalise' :: ProblemConstraint -> ReduceM ProblemConstraint
normalise' (PConstr pid :: Set ProblemId
pid c :: Closure Constraint
c) = Set ProblemId -> Closure Constraint -> ProblemConstraint
PConstr Set ProblemId
pid (Closure Constraint -> ProblemConstraint)
-> ReduceM (Closure Constraint) -> ReduceM ProblemConstraint
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Closure Constraint -> ReduceM (Closure Constraint)
forall t. Normalise t => t -> ReduceM t
normalise' Closure Constraint
c
instance Normalise Constraint where
normalise' :: Constraint -> ReduceM Constraint
normalise' (ValueCmp cmp :: Comparison
cmp t :: CompareAs
t u :: Term
u v :: Term
v) = do
(t :: CompareAs
t,u :: Term
u,v :: Term
v) <- (CompareAs, Term, Term) -> ReduceM (CompareAs, Term, Term)
forall t. Normalise t => t -> ReduceM t
normalise' (CompareAs
t,Term
u,Term
v)
Constraint -> ReduceM Constraint
forall (m :: * -> *) a. Monad m => a -> m a
return (Constraint -> ReduceM Constraint)
-> Constraint -> ReduceM Constraint
forall a b. (a -> b) -> a -> b
$ Comparison -> CompareAs -> Term -> Term -> Constraint
ValueCmp Comparison
cmp CompareAs
t Term
u Term
v
normalise' (ValueCmpOnFace cmp :: Comparison
cmp p :: Term
p t :: Type
t u :: Term
u v :: Term
v) = do
((p :: Term
p,t :: Type
t),u :: Term
u,v :: Term
v) <- ((Term, Type), Term, Term) -> ReduceM ((Term, Type), Term, Term)
forall t. Normalise t => t -> ReduceM t
normalise' ((Term
p,Type
t),Term
u,Term
v)
Constraint -> ReduceM Constraint
forall (m :: * -> *) a. Monad m => a -> m a
return (Constraint -> ReduceM Constraint)
-> Constraint -> ReduceM Constraint
forall a b. (a -> b) -> a -> b
$ Comparison -> Term -> Type -> Term -> Term -> Constraint
ValueCmpOnFace Comparison
cmp Term
p Type
t Term
u Term
v
normalise' (ElimCmp cmp :: [Polarity]
cmp fs :: [IsForced]
fs t :: Type
t v :: Term
v as :: Elims
as bs :: Elims
bs) =
[Polarity]
-> [IsForced] -> Type -> Term -> Elims -> Elims -> Constraint
ElimCmp [Polarity]
cmp [IsForced]
fs (Type -> Term -> Elims -> Elims -> Constraint)
-> ReduceM Type -> ReduceM (Term -> Elims -> Elims -> Constraint)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Type -> ReduceM Type
forall t. Normalise t => t -> ReduceM t
normalise' Type
t ReduceM (Term -> Elims -> Elims -> Constraint)
-> ReduceM Term -> ReduceM (Elims -> Elims -> Constraint)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Term -> ReduceM Term
forall t. Normalise t => t -> ReduceM t
normalise' Term
v ReduceM (Elims -> Elims -> Constraint)
-> ReduceM Elims -> ReduceM (Elims -> Constraint)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Elims -> ReduceM Elims
forall t. Normalise t => t -> ReduceM t
normalise' Elims
as ReduceM (Elims -> Constraint)
-> ReduceM Elims -> ReduceM Constraint
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Elims -> ReduceM Elims
forall t. Normalise t => t -> ReduceM t
normalise' Elims
bs
normalise' (LevelCmp cmp :: Comparison
cmp u :: Level
u v :: Level
v) = (Level -> Level -> Constraint) -> (Level, Level) -> Constraint
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (Comparison -> Level -> Level -> Constraint
LevelCmp Comparison
cmp) ((Level, Level) -> Constraint)
-> ReduceM (Level, Level) -> ReduceM Constraint
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Level, Level) -> ReduceM (Level, Level)
forall t. Normalise t => t -> ReduceM t
normalise' (Level
u,Level
v)
normalise' (TelCmp a :: Type
a b :: Type
b cmp :: Comparison
cmp tela :: Telescope
tela telb :: Telescope
telb) = (Telescope -> Telescope -> Constraint)
-> (Telescope, Telescope) -> Constraint
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (Type -> Type -> Comparison -> Telescope -> Telescope -> Constraint
TelCmp Type
a Type
b Comparison
cmp) ((Telescope, Telescope) -> Constraint)
-> ReduceM (Telescope, Telescope) -> ReduceM Constraint
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Telescope, Telescope) -> ReduceM (Telescope, Telescope)
forall t. Normalise t => t -> ReduceM t
normalise' (Telescope
tela,Telescope
telb)
normalise' (SortCmp cmp :: Comparison
cmp a :: Sort
a b :: Sort
b) = (Sort -> Sort -> Constraint) -> (Sort, Sort) -> Constraint
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (Comparison -> Sort -> Sort -> Constraint
SortCmp Comparison
cmp) ((Sort, Sort) -> Constraint)
-> ReduceM (Sort, Sort) -> ReduceM Constraint
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Sort, Sort) -> ReduceM (Sort, Sort)
forall t. Normalise t => t -> ReduceM t
normalise' (Sort
a,Sort
b)
normalise' (Guarded c :: Constraint
c pid :: ProblemId
pid) = Constraint -> ProblemId -> Constraint
Guarded (Constraint -> ProblemId -> Constraint)
-> ReduceM Constraint -> ReduceM (ProblemId -> Constraint)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Constraint -> ReduceM Constraint
forall t. Normalise t => t -> ReduceM t
normalise' Constraint
c ReduceM (ProblemId -> Constraint)
-> ReduceM ProblemId -> ReduceM Constraint
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ProblemId -> ReduceM ProblemId
forall (f :: * -> *) a. Applicative f => a -> f a
pure ProblemId
pid
normalise' (UnBlock m :: MetaId
m) = Constraint -> ReduceM Constraint
forall (m :: * -> *) a. Monad m => a -> m a
return (Constraint -> ReduceM Constraint)
-> Constraint -> ReduceM Constraint
forall a b. (a -> b) -> a -> b
$ MetaId -> Constraint
UnBlock MetaId
m
normalise' (FindInstance m :: MetaId
m b :: Maybe MetaId
b cands :: Maybe [Candidate]
cands) = MetaId -> Maybe MetaId -> Maybe [Candidate] -> Constraint
FindInstance MetaId
m Maybe MetaId
b (Maybe [Candidate] -> Constraint)
-> ReduceM (Maybe [Candidate]) -> ReduceM Constraint
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Candidate] -> ReduceM [Candidate])
-> Maybe [Candidate] -> ReduceM (Maybe [Candidate])
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM [Candidate] -> ReduceM [Candidate]
forall t. Normalise t => t -> ReduceM t
normalise' Maybe [Candidate]
cands
normalise' (IsEmpty r :: Range
r t :: Type
t) = Range -> Type -> Constraint
IsEmpty Range
r (Type -> Constraint) -> ReduceM Type -> ReduceM Constraint
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Type -> ReduceM Type
forall t. Normalise t => t -> ReduceM t
normalise' Type
t
normalise' (CheckSizeLtSat t :: Term
t) = Term -> Constraint
CheckSizeLtSat (Term -> Constraint) -> ReduceM Term -> ReduceM Constraint
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term -> ReduceM Term
forall t. Normalise t => t -> ReduceM t
normalise' Term
t
normalise' c :: Constraint
c@CheckFunDef{} = Constraint -> ReduceM Constraint
forall (m :: * -> *) a. Monad m => a -> m a
return Constraint
c
normalise' (HasBiggerSort a :: Sort
a) = Sort -> Constraint
HasBiggerSort (Sort -> Constraint) -> ReduceM Sort -> ReduceM Constraint
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sort -> ReduceM Sort
forall t. Normalise t => t -> ReduceM t
normalise' Sort
a
normalise' (HasPTSRule a :: Dom Type
a b :: Abs Sort
b) = (Dom Type -> Abs Sort -> Constraint)
-> (Dom Type, Abs Sort) -> Constraint
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Dom Type -> Abs Sort -> Constraint
HasPTSRule ((Dom Type, Abs Sort) -> Constraint)
-> ReduceM (Dom Type, Abs Sort) -> ReduceM Constraint
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Dom Type, Abs Sort) -> ReduceM (Dom Type, Abs Sort)
forall t. Normalise t => t -> ReduceM t
normalise' (Dom Type
a,Abs Sort
b)
normalise' (UnquoteTactic m :: Maybe MetaId
m t :: Term
t h :: Term
h g :: Type
g) = Maybe MetaId -> Term -> Term -> Type -> Constraint
UnquoteTactic Maybe MetaId
m (Term -> Term -> Type -> Constraint)
-> ReduceM Term -> ReduceM (Term -> Type -> Constraint)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term -> ReduceM Term
forall t. Normalise t => t -> ReduceM t
normalise' Term
t ReduceM (Term -> Type -> Constraint)
-> ReduceM Term -> ReduceM (Type -> Constraint)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Term -> ReduceM Term
forall t. Normalise t => t -> ReduceM t
normalise' Term
h ReduceM (Type -> Constraint) -> ReduceM Type -> ReduceM Constraint
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Type -> ReduceM Type
forall t. Normalise t => t -> ReduceM t
normalise' Type
g
normalise' c :: Constraint
c@CheckMetaInst{} = Constraint -> ReduceM Constraint
forall (m :: * -> *) a. Monad m => a -> m a
return Constraint
c
instance Normalise CompareAs where
normalise' :: CompareAs -> ReduceM CompareAs
normalise' (AsTermsOf a :: Type
a) = Type -> CompareAs
AsTermsOf (Type -> CompareAs) -> ReduceM Type -> ReduceM CompareAs
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Type -> ReduceM Type
forall t. Normalise t => t -> ReduceM t
normalise' Type
a
normalise' AsSizes = CompareAs -> ReduceM CompareAs
forall (m :: * -> *) a. Monad m => a -> m a
return CompareAs
AsSizes
normalise' AsTypes = CompareAs -> ReduceM CompareAs
forall (m :: * -> *) a. Monad m => a -> m a
return CompareAs
AsTypes
instance Normalise ConPatternInfo where
normalise' :: ConPatternInfo -> ReduceM ConPatternInfo
normalise' i :: ConPatternInfo
i = Maybe (Arg Type) -> ReduceM (Maybe (Arg Type))
forall t. Normalise t => t -> ReduceM t
normalise' (ConPatternInfo -> Maybe (Arg Type)
conPType ConPatternInfo
i) ReduceM (Maybe (Arg Type))
-> (Maybe (Arg Type) -> ConPatternInfo) -> ReduceM ConPatternInfo
forall (m :: * -> *) a b. Functor m => m a -> (a -> b) -> m b
<&> \ t :: Maybe (Arg Type)
t -> ConPatternInfo
i { conPType :: Maybe (Arg Type)
conPType = Maybe (Arg Type)
t }
instance Normalise a => Normalise (Pattern' a) where
normalise' :: Pattern' a -> ReduceM (Pattern' a)
normalise' p :: Pattern' a
p = case Pattern' a
p of
VarP o :: PatternInfo
o x :: a
x -> PatternInfo -> a -> Pattern' a
forall x. PatternInfo -> x -> Pattern' x
VarP PatternInfo
o (a -> Pattern' a) -> ReduceM a -> ReduceM (Pattern' a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> ReduceM a
forall t. Normalise t => t -> ReduceM t
normalise' a
x
LitP{} -> Pattern' a -> ReduceM (Pattern' a)
forall (m :: * -> *) a. Monad m => a -> m a
return Pattern' a
p
ConP c :: ConHead
c mt :: ConPatternInfo
mt ps :: [NamedArg (Pattern' a)]
ps -> ConHead -> ConPatternInfo -> [NamedArg (Pattern' a)] -> Pattern' a
forall x.
ConHead -> ConPatternInfo -> [NamedArg (Pattern' x)] -> Pattern' x
ConP ConHead
c (ConPatternInfo -> [NamedArg (Pattern' a)] -> Pattern' a)
-> ReduceM ConPatternInfo
-> ReduceM ([NamedArg (Pattern' a)] -> Pattern' a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ConPatternInfo -> ReduceM ConPatternInfo
forall t. Normalise t => t -> ReduceM t
normalise' ConPatternInfo
mt ReduceM ([NamedArg (Pattern' a)] -> Pattern' a)
-> ReduceM [NamedArg (Pattern' a)] -> ReduceM (Pattern' a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [NamedArg (Pattern' a)] -> ReduceM [NamedArg (Pattern' a)]
forall t. Normalise t => t -> ReduceM t
normalise' [NamedArg (Pattern' a)]
ps
DefP o :: PatternInfo
o q :: QName
q ps :: [NamedArg (Pattern' a)]
ps -> PatternInfo -> QName -> [NamedArg (Pattern' a)] -> Pattern' a
forall x.
PatternInfo -> QName -> [NamedArg (Pattern' x)] -> Pattern' x
DefP PatternInfo
o QName
q ([NamedArg (Pattern' a)] -> Pattern' a)
-> ReduceM [NamedArg (Pattern' a)] -> ReduceM (Pattern' a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [NamedArg (Pattern' a)] -> ReduceM [NamedArg (Pattern' a)]
forall t. Normalise t => t -> ReduceM t
normalise' [NamedArg (Pattern' a)]
ps
DotP o :: PatternInfo
o v :: Term
v -> PatternInfo -> Term -> Pattern' a
forall x. PatternInfo -> Term -> Pattern' x
DotP PatternInfo
o (Term -> Pattern' a) -> ReduceM Term -> ReduceM (Pattern' a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term -> ReduceM Term
forall t. Normalise t => t -> ReduceM t
normalise' Term
v
ProjP{} -> Pattern' a -> ReduceM (Pattern' a)
forall (m :: * -> *) a. Monad m => a -> m a
return Pattern' a
p
IApplyP o :: PatternInfo
o t :: Term
t u :: Term
u x :: a
x -> PatternInfo -> Term -> Term -> a -> Pattern' a
forall x. PatternInfo -> Term -> Term -> x -> Pattern' x
IApplyP PatternInfo
o (Term -> Term -> a -> Pattern' a)
-> ReduceM Term -> ReduceM (Term -> a -> Pattern' a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term -> ReduceM Term
forall t. Normalise t => t -> ReduceM t
normalise' Term
t ReduceM (Term -> a -> Pattern' a)
-> ReduceM Term -> ReduceM (a -> Pattern' a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Term -> ReduceM Term
forall t. Normalise t => t -> ReduceM t
normalise' Term
u ReduceM (a -> Pattern' a) -> ReduceM a -> ReduceM (Pattern' a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> ReduceM a
forall t. Normalise t => t -> ReduceM t
normalise' a
x
instance Normalise DisplayForm where
normalise' :: DisplayForm -> ReduceM DisplayForm
normalise' (Display n :: Int
n ps :: Elims
ps v :: DisplayTerm
v) = Int -> Elims -> DisplayTerm -> DisplayForm
Display Int
n (Elims -> DisplayTerm -> DisplayForm)
-> ReduceM Elims -> ReduceM (DisplayTerm -> DisplayForm)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Elims -> ReduceM Elims
forall t. Normalise t => t -> ReduceM t
normalise' Elims
ps ReduceM (DisplayTerm -> DisplayForm)
-> ReduceM DisplayTerm -> ReduceM DisplayForm
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> DisplayTerm -> ReduceM DisplayTerm
forall (m :: * -> *) a. Monad m => a -> m a
return DisplayTerm
v
instance Normalise Candidate where
normalise' :: Candidate -> ReduceM Candidate
normalise' (Candidate u :: Term
u t :: Type
t ov :: Bool
ov) = Term -> Type -> Bool -> Candidate
Candidate (Term -> Type -> Bool -> Candidate)
-> ReduceM Term -> ReduceM (Type -> Bool -> Candidate)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term -> ReduceM Term
forall t. Normalise t => t -> ReduceM t
normalise' Term
u ReduceM (Type -> Bool -> Candidate)
-> ReduceM Type -> ReduceM (Bool -> Candidate)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Type -> ReduceM Type
forall t. Normalise t => t -> ReduceM t
normalise' Type
t ReduceM (Bool -> Candidate) -> ReduceM Bool -> ReduceM Candidate
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Bool -> ReduceM Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
ov
instance Normalise EqualityView where
normalise' :: EqualityView -> ReduceM EqualityView
normalise' (OtherType t :: Type
t) = Type -> EqualityView
OtherType
(Type -> EqualityView) -> ReduceM Type -> ReduceM EqualityView
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Type -> ReduceM Type
forall t. Normalise t => t -> ReduceM t
normalise' Type
t
normalise' (EqualityType s :: Sort
s eq :: QName
eq l :: [Arg Term]
l t :: Arg Term
t a :: Arg Term
a b :: Arg Term
b) = Sort
-> QName
-> [Arg Term]
-> Arg Term
-> Arg Term
-> Arg Term
-> EqualityView
EqualityType
(Sort
-> QName
-> [Arg Term]
-> Arg Term
-> Arg Term
-> Arg Term
-> EqualityView)
-> ReduceM Sort
-> ReduceM
(QName
-> [Arg Term] -> Arg Term -> Arg Term -> Arg Term -> EqualityView)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sort -> ReduceM Sort
forall t. Normalise t => t -> ReduceM t
normalise' Sort
s
ReduceM
(QName
-> [Arg Term] -> Arg Term -> Arg Term -> Arg Term -> EqualityView)
-> ReduceM QName
-> ReduceM
([Arg Term] -> Arg Term -> Arg Term -> Arg Term -> EqualityView)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> QName -> ReduceM QName
forall (m :: * -> *) a. Monad m => a -> m a
return QName
eq
ReduceM
([Arg Term] -> Arg Term -> Arg Term -> Arg Term -> EqualityView)
-> ReduceM [Arg Term]
-> ReduceM (Arg Term -> Arg Term -> Arg Term -> EqualityView)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Arg Term -> ReduceM (Arg Term))
-> [Arg Term] -> ReduceM [Arg Term]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Arg Term -> ReduceM (Arg Term)
forall t. Normalise t => t -> ReduceM t
normalise' [Arg Term]
l
ReduceM (Arg Term -> Arg Term -> Arg Term -> EqualityView)
-> ReduceM (Arg Term)
-> ReduceM (Arg Term -> Arg Term -> EqualityView)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Arg Term -> ReduceM (Arg Term)
forall t. Normalise t => t -> ReduceM t
normalise' Arg Term
t
ReduceM (Arg Term -> Arg Term -> EqualityView)
-> ReduceM (Arg Term) -> ReduceM (Arg Term -> EqualityView)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Arg Term -> ReduceM (Arg Term)
forall t. Normalise t => t -> ReduceM t
normalise' Arg Term
a
ReduceM (Arg Term -> EqualityView)
-> ReduceM (Arg Term) -> ReduceM EqualityView
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Arg Term -> ReduceM (Arg Term)
forall t. Normalise t => t -> ReduceM t
normalise' Arg Term
b
class InstantiateFull t where
instantiateFull' :: t -> ReduceM t
default instantiateFull' :: (t ~ f a, Traversable f, InstantiateFull a) => t -> ReduceM t
instantiateFull' = (a -> ReduceM a) -> f a -> ReduceM (f a)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> ReduceM a
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull'
instance InstantiateFull t => InstantiateFull [t]
instance InstantiateFull t => InstantiateFull (HashMap k t)
instance InstantiateFull t => InstantiateFull (Map k t)
instance InstantiateFull t => InstantiateFull (Maybe t)
instance InstantiateFull t => InstantiateFull (Strict.Maybe t)
instance InstantiateFull t => InstantiateFull (Arg t)
instance InstantiateFull t => InstantiateFull (Elim' t)
instance InstantiateFull t => InstantiateFull (Named name t)
instance InstantiateFull t => InstantiateFull (Open t)
instance InstantiateFull t => InstantiateFull (WithArity t)
instance (InstantiateFull a, InstantiateFull b) => InstantiateFull (a,b) where
instantiateFull' :: (a, b) -> ReduceM (a, b)
instantiateFull' (x :: a
x,y :: b
y) = (,) (a -> b -> (a, b)) -> ReduceM a -> ReduceM (b -> (a, b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> ReduceM a
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' a
x ReduceM (b -> (a, b)) -> ReduceM b -> ReduceM (a, b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> b -> ReduceM b
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' b
y
instance (InstantiateFull a, InstantiateFull b, InstantiateFull c) => InstantiateFull (a,b,c) where
instantiateFull' :: (a, b, c) -> ReduceM (a, b, c)
instantiateFull' (x :: a
x,y :: b
y,z :: c
z) =
do (x :: a
x,(y :: b
y,z :: c
z)) <- (a, (b, c)) -> ReduceM (a, (b, c))
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' (a
x,(b
y,c
z))
(a, b, c) -> ReduceM (a, b, c)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
x,b
y,c
z)
instance (InstantiateFull a, InstantiateFull b, InstantiateFull c, InstantiateFull d) => InstantiateFull (a,b,c,d) where
instantiateFull' :: (a, b, c, d) -> ReduceM (a, b, c, d)
instantiateFull' (x :: a
x,y :: b
y,z :: c
z,w :: d
w) =
do (x :: a
x,(y :: b
y,z :: c
z,w :: d
w)) <- (a, (b, c, d)) -> ReduceM (a, (b, c, d))
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' (a
x,(b
y,c
z,d
w))
(a, b, c, d) -> ReduceM (a, b, c, d)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
x,b
y,c
z,d
w)
instance InstantiateFull Bool where
instantiateFull' :: Bool -> ReduceM Bool
instantiateFull' = Bool -> ReduceM Bool
forall (m :: * -> *) a. Monad m => a -> m a
return
instance InstantiateFull Char where
instantiateFull' :: Char -> ReduceM Char
instantiateFull' = Char -> ReduceM Char
forall (m :: * -> *) a. Monad m => a -> m a
return
instance InstantiateFull Int where
instantiateFull' :: Int -> ReduceM Int
instantiateFull' = Int -> ReduceM Int
forall (m :: * -> *) a. Monad m => a -> m a
return
instance InstantiateFull ModuleName where
instantiateFull' :: ModuleName -> ReduceM ModuleName
instantiateFull' = ModuleName -> ReduceM ModuleName
forall (m :: * -> *) a. Monad m => a -> m a
return
instance InstantiateFull Name where
instantiateFull' :: Name -> ReduceM Name
instantiateFull' = Name -> ReduceM Name
forall (m :: * -> *) a. Monad m => a -> m a
return
instance InstantiateFull QName where
instantiateFull' :: QName -> ReduceM QName
instantiateFull' = QName -> ReduceM QName
forall (m :: * -> *) a. Monad m => a -> m a
return
instance InstantiateFull Scope where
instantiateFull' :: Scope -> ReduceM Scope
instantiateFull' = Scope -> ReduceM Scope
forall (m :: * -> *) a. Monad m => a -> m a
return
instance InstantiateFull ConHead where
instantiateFull' :: ConHead -> ReduceM ConHead
instantiateFull' = ConHead -> ReduceM ConHead
forall (m :: * -> *) a. Monad m => a -> m a
return
instance InstantiateFull DBPatVar where
instantiateFull' :: DBPatVar -> ReduceM DBPatVar
instantiateFull' = DBPatVar -> ReduceM DBPatVar
forall (m :: * -> *) a. Monad m => a -> m a
return
instance InstantiateFull Sort where
instantiateFull' :: Sort -> ReduceM Sort
instantiateFull' s :: Sort
s = do
Sort
s <- Sort -> ReduceM Sort
forall t. Instantiate t => t -> ReduceM t
instantiate' Sort
s
case Sort
s of
Type n :: Level
n -> Level -> Sort
forall t. Level' t -> Sort' t
Type (Level -> Sort) -> ReduceM Level -> ReduceM Sort
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Level -> ReduceM Level
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' Level
n
Prop n :: Level
n -> Level -> Sort
forall t. Level' t -> Sort' t
Prop (Level -> Sort) -> ReduceM Level -> ReduceM Sort
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Level -> ReduceM Level
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' Level
n
PiSort a :: Dom Type
a s :: Abs Sort
s -> Dom Type -> Abs Sort -> Sort
piSort (Dom Type -> Abs Sort -> Sort)
-> ReduceM (Dom Type) -> ReduceM (Abs Sort -> Sort)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Dom Type -> ReduceM (Dom Type)
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' Dom Type
a ReduceM (Abs Sort -> Sort) -> ReduceM (Abs Sort) -> ReduceM Sort
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Abs Sort -> ReduceM (Abs Sort)
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' Abs Sort
s
FunSort s1 :: Sort
s1 s2 :: Sort
s2 -> Sort -> Sort -> Sort
funSort (Sort -> Sort -> Sort) -> ReduceM Sort -> ReduceM (Sort -> Sort)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sort -> ReduceM Sort
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' Sort
s1 ReduceM (Sort -> Sort) -> ReduceM Sort -> ReduceM Sort
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Sort -> ReduceM Sort
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' Sort
s2
UnivSort s :: Sort
s -> do
Maybe Sort
ui <- ReduceM (Maybe Sort)
forall (m :: * -> *). HasOptions m => m (Maybe Sort)
univInf
Maybe Sort -> Sort -> Sort
univSort Maybe Sort
ui (Sort -> Sort) -> ReduceM Sort -> ReduceM Sort
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sort -> ReduceM Sort
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' Sort
s
Inf -> Sort -> ReduceM Sort
forall (m :: * -> *) a. Monad m => a -> m a
return Sort
s
SizeUniv -> Sort -> ReduceM Sort
forall (m :: * -> *) a. Monad m => a -> m a
return Sort
s
MetaS x :: MetaId
x es :: Elims
es -> MetaId -> Elims -> Sort
forall t. MetaId -> [Elim' t] -> Sort' t
MetaS MetaId
x (Elims -> Sort) -> ReduceM Elims -> ReduceM Sort
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Elims -> ReduceM Elims
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' Elims
es
DefS d :: QName
d es :: Elims
es -> QName -> Elims -> Sort
forall t. QName -> [Elim' t] -> Sort' t
DefS QName
d (Elims -> Sort) -> ReduceM Elims -> ReduceM Sort
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Elims -> ReduceM Elims
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' Elims
es
DummyS{} -> Sort -> ReduceM Sort
forall (m :: * -> *) a. Monad m => a -> m a
return Sort
s
instance InstantiateFull t => InstantiateFull (Type' t) where
instantiateFull' :: Type' t -> ReduceM (Type' t)
instantiateFull' (El s :: Sort
s t :: t
t) =
Sort -> t -> Type' t
forall t a. Sort' t -> a -> Type'' t a
El (Sort -> t -> Type' t) -> ReduceM Sort -> ReduceM (t -> Type' t)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sort -> ReduceM Sort
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' Sort
s ReduceM (t -> Type' t) -> ReduceM t -> ReduceM (Type' t)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> t -> ReduceM t
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' t
t
instance InstantiateFull Term where
instantiateFull' :: Term -> ReduceM Term
instantiateFull' v :: Term
v = Term -> ReduceM Term
forall (m :: * -> *).
(MonadTCEnv m, HasConstInfo m, HasOptions m) =>
Term -> m Term
etaOnce (Term -> ReduceM Term) -> ReduceM Term -> ReduceM Term
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< do
Term
v <- Term -> ReduceM Term
forall t. Instantiate t => t -> ReduceM t
instantiate' Term
v
case Term
v of
Var n :: Int
n vs :: Elims
vs -> Int -> Elims -> Term
Var Int
n (Elims -> Term) -> ReduceM Elims -> ReduceM Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Elims -> ReduceM Elims
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' Elims
vs
Con c :: ConHead
c ci :: ConInfo
ci vs :: Elims
vs -> ConHead -> ConInfo -> Elims -> Term
Con ConHead
c ConInfo
ci (Elims -> Term) -> ReduceM Elims -> ReduceM Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Elims -> ReduceM Elims
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' Elims
vs
Def f :: QName
f vs :: Elims
vs -> QName -> Elims -> Term
Def QName
f (Elims -> Term) -> ReduceM Elims -> ReduceM Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Elims -> ReduceM Elims
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' Elims
vs
MetaV x :: MetaId
x vs :: Elims
vs -> MetaId -> Elims -> Term
MetaV MetaId
x (Elims -> Term) -> ReduceM Elims -> ReduceM Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Elims -> ReduceM Elims
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' Elims
vs
Lit _ -> Term -> ReduceM Term
forall (m :: * -> *) a. Monad m => a -> m a
return Term
v
Level l :: Level
l -> Level -> Term
levelTm (Level -> Term) -> ReduceM Level -> ReduceM Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Level -> ReduceM Level
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' Level
l
Lam h :: ArgInfo
h b :: Abs Term
b -> ArgInfo -> Abs Term -> Term
Lam ArgInfo
h (Abs Term -> Term) -> ReduceM (Abs Term) -> ReduceM Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Abs Term -> ReduceM (Abs Term)
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' Abs Term
b
Sort s :: Sort
s -> Sort -> Term
Sort (Sort -> Term) -> ReduceM Sort -> ReduceM Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sort -> ReduceM Sort
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' Sort
s
Pi a :: Dom Type
a b :: Abs Type
b -> (Dom Type -> Abs Type -> Term) -> (Dom Type, Abs Type) -> Term
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Dom Type -> Abs Type -> Term
Pi ((Dom Type, Abs Type) -> Term)
-> ReduceM (Dom Type, Abs Type) -> ReduceM Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Dom Type, Abs Type) -> ReduceM (Dom Type, Abs Type)
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' (Dom Type
a,Abs Type
b)
DontCare v :: Term
v -> Term -> Term
dontCare (Term -> Term) -> ReduceM Term -> ReduceM Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term -> ReduceM Term
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' Term
v
Dummy{} -> Term -> ReduceM Term
forall (m :: * -> *) a. Monad m => a -> m a
return Term
v
instance InstantiateFull Level where
instantiateFull' :: Level -> ReduceM Level
instantiateFull' (Max m :: Integer
m as :: [PlusLevel' Term]
as) = Integer -> [PlusLevel' Term] -> Level
levelMax Integer
m ([PlusLevel' Term] -> Level)
-> ReduceM [PlusLevel' Term] -> ReduceM Level
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [PlusLevel' Term] -> ReduceM [PlusLevel' Term]
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' [PlusLevel' Term]
as
instance InstantiateFull PlusLevel where
instantiateFull' :: PlusLevel' Term -> ReduceM (PlusLevel' Term)
instantiateFull' (Plus n :: Integer
n l :: LevelAtom' Term
l) = Integer -> LevelAtom' Term -> PlusLevel' Term
forall t. Integer -> LevelAtom' t -> PlusLevel' t
Plus Integer
n (LevelAtom' Term -> PlusLevel' Term)
-> ReduceM (LevelAtom' Term) -> ReduceM (PlusLevel' Term)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LevelAtom' Term -> ReduceM (LevelAtom' Term)
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' LevelAtom' Term
l
instance InstantiateFull LevelAtom where
instantiateFull' :: LevelAtom' Term -> ReduceM (LevelAtom' Term)
instantiateFull' l :: LevelAtom' Term
l = case LevelAtom' Term
l of
MetaLevel m :: MetaId
m vs :: Elims
vs -> do
Term
v <- Term -> ReduceM Term
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' (MetaId -> Elims -> Term
MetaV MetaId
m Elims
vs)
case Term
v of
MetaV m :: MetaId
m vs :: Elims
vs -> LevelAtom' Term -> ReduceM (LevelAtom' Term)
forall (m :: * -> *) a. Monad m => a -> m a
return (LevelAtom' Term -> ReduceM (LevelAtom' Term))
-> LevelAtom' Term -> ReduceM (LevelAtom' Term)
forall a b. (a -> b) -> a -> b
$ MetaId -> Elims -> LevelAtom' Term
forall t. MetaId -> [Elim' t] -> LevelAtom' t
MetaLevel MetaId
m Elims
vs
_ -> LevelAtom' Term -> ReduceM (LevelAtom' Term)
forall (m :: * -> *) a. Monad m => a -> m a
return (LevelAtom' Term -> ReduceM (LevelAtom' Term))
-> LevelAtom' Term -> ReduceM (LevelAtom' Term)
forall a b. (a -> b) -> a -> b
$ Term -> LevelAtom' Term
forall t. t -> LevelAtom' t
UnreducedLevel Term
v
NeutralLevel r :: NotBlocked
r v :: Term
v -> NotBlocked -> Term -> LevelAtom' Term
forall t. NotBlocked -> t -> LevelAtom' t
NeutralLevel NotBlocked
r (Term -> LevelAtom' Term)
-> ReduceM Term -> ReduceM (LevelAtom' Term)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term -> ReduceM Term
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' Term
v
BlockedLevel m :: MetaId
m v :: Term
v ->
ReduceM Bool
-> ReduceM (LevelAtom' Term)
-> ReduceM (LevelAtom' Term)
-> ReduceM (LevelAtom' Term)
forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifM (MetaId -> ReduceM Bool
forall a (m :: * -> *).
(IsInstantiatedMeta a, MonadFail m, ReadTCState m) =>
a -> m Bool
isInstantiatedMeta MetaId
m)
(Term -> LevelAtom' Term
forall t. t -> LevelAtom' t
UnreducedLevel (Term -> LevelAtom' Term)
-> ReduceM Term -> ReduceM (LevelAtom' Term)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term -> ReduceM Term
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' Term
v)
(MetaId -> Term -> LevelAtom' Term
forall t. MetaId -> t -> LevelAtom' t
BlockedLevel MetaId
m (Term -> LevelAtom' Term)
-> ReduceM Term -> ReduceM (LevelAtom' Term)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term -> ReduceM Term
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' Term
v)
UnreducedLevel v :: Term
v -> Term -> LevelAtom' Term
forall t. t -> LevelAtom' t
UnreducedLevel (Term -> LevelAtom' Term)
-> ReduceM Term -> ReduceM (LevelAtom' Term)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term -> ReduceM Term
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' Term
v
instance InstantiateFull Substitution where
instantiateFull' :: Substitution' Term -> ReduceM (Substitution' Term)
instantiateFull' sigma :: Substitution' Term
sigma =
case Substitution' Term
sigma of
IdS -> Substitution' Term -> ReduceM (Substitution' Term)
forall (m :: * -> *) a. Monad m => a -> m a
return Substitution' Term
forall a. Substitution' a
IdS
EmptyS err :: Empty
err -> Substitution' Term -> ReduceM (Substitution' Term)
forall (m :: * -> *) a. Monad m => a -> m a
return (Substitution' Term -> ReduceM (Substitution' Term))
-> Substitution' Term -> ReduceM (Substitution' Term)
forall a b. (a -> b) -> a -> b
$ Empty -> Substitution' Term
forall a. Empty -> Substitution' a
EmptyS Empty
err
Wk n :: Int
n sigma :: Substitution' Term
sigma -> Int -> Substitution' Term -> Substitution' Term
forall a. Int -> Substitution' a -> Substitution' a
Wk Int
n (Substitution' Term -> Substitution' Term)
-> ReduceM (Substitution' Term) -> ReduceM (Substitution' Term)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Substitution' Term -> ReduceM (Substitution' Term)
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' Substitution' Term
sigma
Lift n :: Int
n sigma :: Substitution' Term
sigma -> Int -> Substitution' Term -> Substitution' Term
forall a. Int -> Substitution' a -> Substitution' a
Lift Int
n (Substitution' Term -> Substitution' Term)
-> ReduceM (Substitution' Term) -> ReduceM (Substitution' Term)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Substitution' Term -> ReduceM (Substitution' Term)
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' Substitution' Term
sigma
Strengthen bot :: Empty
bot sigma :: Substitution' Term
sigma -> Empty -> Substitution' Term -> Substitution' Term
forall a. Empty -> Substitution' a -> Substitution' a
Strengthen Empty
bot (Substitution' Term -> Substitution' Term)
-> ReduceM (Substitution' Term) -> ReduceM (Substitution' Term)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Substitution' Term -> ReduceM (Substitution' Term)
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' Substitution' Term
sigma
t :: Term
t :# sigma :: Substitution' Term
sigma -> Term -> Substitution' Term -> Substitution' Term
forall a. DeBruijn a => a -> Substitution' a -> Substitution' a
consS (Term -> Substitution' Term -> Substitution' Term)
-> ReduceM Term
-> ReduceM (Substitution' Term -> Substitution' Term)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term -> ReduceM Term
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' Term
t
ReduceM (Substitution' Term -> Substitution' Term)
-> ReduceM (Substitution' Term) -> ReduceM (Substitution' Term)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Substitution' Term -> ReduceM (Substitution' Term)
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' Substitution' Term
sigma
instance InstantiateFull ConPatternInfo where
instantiateFull' :: ConPatternInfo -> ReduceM ConPatternInfo
instantiateFull' i :: ConPatternInfo
i = Maybe (Arg Type) -> ReduceM (Maybe (Arg Type))
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' (ConPatternInfo -> Maybe (Arg Type)
conPType ConPatternInfo
i) ReduceM (Maybe (Arg Type))
-> (Maybe (Arg Type) -> ConPatternInfo) -> ReduceM ConPatternInfo
forall (m :: * -> *) a b. Functor m => m a -> (a -> b) -> m b
<&> \ t :: Maybe (Arg Type)
t -> ConPatternInfo
i { conPType :: Maybe (Arg Type)
conPType = Maybe (Arg Type)
t }
instance InstantiateFull a => InstantiateFull (Pattern' a) where
instantiateFull' :: Pattern' a -> ReduceM (Pattern' a)
instantiateFull' (VarP o :: PatternInfo
o x :: a
x) = PatternInfo -> a -> Pattern' a
forall x. PatternInfo -> x -> Pattern' x
VarP PatternInfo
o (a -> Pattern' a) -> ReduceM a -> ReduceM (Pattern' a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> ReduceM a
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' a
x
instantiateFull' (DotP o :: PatternInfo
o t :: Term
t) = PatternInfo -> Term -> Pattern' a
forall x. PatternInfo -> Term -> Pattern' x
DotP PatternInfo
o (Term -> Pattern' a) -> ReduceM Term -> ReduceM (Pattern' a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term -> ReduceM Term
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' Term
t
instantiateFull' (ConP n :: ConHead
n mt :: ConPatternInfo
mt ps :: [NamedArg (Pattern' a)]
ps) = ConHead -> ConPatternInfo -> [NamedArg (Pattern' a)] -> Pattern' a
forall x.
ConHead -> ConPatternInfo -> [NamedArg (Pattern' x)] -> Pattern' x
ConP ConHead
n (ConPatternInfo -> [NamedArg (Pattern' a)] -> Pattern' a)
-> ReduceM ConPatternInfo
-> ReduceM ([NamedArg (Pattern' a)] -> Pattern' a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ConPatternInfo -> ReduceM ConPatternInfo
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' ConPatternInfo
mt ReduceM ([NamedArg (Pattern' a)] -> Pattern' a)
-> ReduceM [NamedArg (Pattern' a)] -> ReduceM (Pattern' a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [NamedArg (Pattern' a)] -> ReduceM [NamedArg (Pattern' a)]
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' [NamedArg (Pattern' a)]
ps
instantiateFull' (DefP o :: PatternInfo
o q :: QName
q ps :: [NamedArg (Pattern' a)]
ps) = PatternInfo -> QName -> [NamedArg (Pattern' a)] -> Pattern' a
forall x.
PatternInfo -> QName -> [NamedArg (Pattern' x)] -> Pattern' x
DefP PatternInfo
o QName
q ([NamedArg (Pattern' a)] -> Pattern' a)
-> ReduceM [NamedArg (Pattern' a)] -> ReduceM (Pattern' a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [NamedArg (Pattern' a)] -> ReduceM [NamedArg (Pattern' a)]
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' [NamedArg (Pattern' a)]
ps
instantiateFull' l :: Pattern' a
l@LitP{} = Pattern' a -> ReduceM (Pattern' a)
forall (m :: * -> *) a. Monad m => a -> m a
return Pattern' a
l
instantiateFull' p :: Pattern' a
p@ProjP{} = Pattern' a -> ReduceM (Pattern' a)
forall (m :: * -> *) a. Monad m => a -> m a
return Pattern' a
p
instantiateFull' (IApplyP o :: PatternInfo
o t :: Term
t u :: Term
u x :: a
x) = PatternInfo -> Term -> Term -> a -> Pattern' a
forall x. PatternInfo -> Term -> Term -> x -> Pattern' x
IApplyP PatternInfo
o (Term -> Term -> a -> Pattern' a)
-> ReduceM Term -> ReduceM (Term -> a -> Pattern' a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term -> ReduceM Term
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' Term
t ReduceM (Term -> a -> Pattern' a)
-> ReduceM Term -> ReduceM (a -> Pattern' a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Term -> ReduceM Term
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' Term
u ReduceM (a -> Pattern' a) -> ReduceM a -> ReduceM (Pattern' a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> ReduceM a
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' a
x
instance (Subst t a, InstantiateFull a) => InstantiateFull (Abs a) where
instantiateFull' :: Abs a -> ReduceM (Abs a)
instantiateFull' a :: Abs a
a@(Abs x :: String
x _) = String -> a -> Abs a
forall a. String -> a -> Abs a
Abs String
x (a -> Abs a) -> ReduceM a -> ReduceM (Abs a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Abs a -> (a -> ReduceM a) -> ReduceM a
forall t a (m :: * -> *) b.
(Subst t a, MonadAddContext m) =>
Abs a -> (a -> m b) -> m b
underAbstraction_ Abs a
a a -> ReduceM a
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull'
instantiateFull' (NoAbs x :: String
x a :: a
a) = String -> a -> Abs a
forall a. String -> a -> Abs a
NoAbs String
x (a -> Abs a) -> ReduceM a -> ReduceM (Abs a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> ReduceM a
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' a
a
instance (InstantiateFull t, InstantiateFull e) => InstantiateFull (Dom' t e) where
instantiateFull' :: Dom' t e -> ReduceM (Dom' t e)
instantiateFull' (Dom i :: ArgInfo
i fin :: Bool
fin n :: Maybe NamedName
n tac :: Maybe t
tac x :: e
x) = ArgInfo -> Bool -> Maybe NamedName -> Maybe t -> e -> Dom' t e
forall t e.
ArgInfo -> Bool -> Maybe NamedName -> Maybe t -> e -> Dom' t e
Dom ArgInfo
i Bool
fin Maybe NamedName
n (Maybe t -> e -> Dom' t e)
-> ReduceM (Maybe t) -> ReduceM (e -> Dom' t e)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe t -> ReduceM (Maybe t)
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' Maybe t
tac ReduceM (e -> Dom' t e) -> ReduceM e -> ReduceM (Dom' t e)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> e -> ReduceM e
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' e
x
instance InstantiateFull a => InstantiateFull (Closure a) where
instantiateFull' :: Closure a -> ReduceM (Closure a)
instantiateFull' cl :: Closure a
cl = do
a
x <- Closure a -> (a -> ReduceM a) -> ReduceM a
forall a c b. LensClosure a c => c -> (a -> ReduceM b) -> ReduceM b
enterClosure Closure a
cl a -> ReduceM a
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull'
Closure a -> ReduceM (Closure a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Closure a -> ReduceM (Closure a))
-> Closure a -> ReduceM (Closure a)
forall a b. (a -> b) -> a -> b
$ Closure a
cl { clValue :: a
clValue = a
x }
instance InstantiateFull ProblemConstraint where
instantiateFull' :: ProblemConstraint -> ReduceM ProblemConstraint
instantiateFull' (PConstr p :: Set ProblemId
p c :: Closure Constraint
c) = Set ProblemId -> Closure Constraint -> ProblemConstraint
PConstr Set ProblemId
p (Closure Constraint -> ProblemConstraint)
-> ReduceM (Closure Constraint) -> ReduceM ProblemConstraint
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Closure Constraint -> ReduceM (Closure Constraint)
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' Closure Constraint
c
instance InstantiateFull Constraint where
instantiateFull' :: Constraint -> ReduceM Constraint
instantiateFull' c :: Constraint
c = case Constraint
c of
ValueCmp cmp :: Comparison
cmp t :: CompareAs
t u :: Term
u v :: Term
v -> do
(t :: CompareAs
t,u :: Term
u,v :: Term
v) <- (CompareAs, Term, Term) -> ReduceM (CompareAs, Term, Term)
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' (CompareAs
t,Term
u,Term
v)
Constraint -> ReduceM Constraint
forall (m :: * -> *) a. Monad m => a -> m a
return (Constraint -> ReduceM Constraint)
-> Constraint -> ReduceM Constraint
forall a b. (a -> b) -> a -> b
$ Comparison -> CompareAs -> Term -> Term -> Constraint
ValueCmp Comparison
cmp CompareAs
t Term
u Term
v
ValueCmpOnFace cmp :: Comparison
cmp p :: Term
p t :: Type
t u :: Term
u v :: Term
v -> do
((p :: Term
p,t :: Type
t),u :: Term
u,v :: Term
v) <- ((Term, Type), Term, Term) -> ReduceM ((Term, Type), Term, Term)
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' ((Term
p,Type
t),Term
u,Term
v)
Constraint -> ReduceM Constraint
forall (m :: * -> *) a. Monad m => a -> m a
return (Constraint -> ReduceM Constraint)
-> Constraint -> ReduceM Constraint
forall a b. (a -> b) -> a -> b
$ Comparison -> Term -> Type -> Term -> Term -> Constraint
ValueCmpOnFace Comparison
cmp Term
p Type
t Term
u Term
v
ElimCmp cmp :: [Polarity]
cmp fs :: [IsForced]
fs t :: Type
t v :: Term
v as :: Elims
as bs :: Elims
bs ->
[Polarity]
-> [IsForced] -> Type -> Term -> Elims -> Elims -> Constraint
ElimCmp [Polarity]
cmp [IsForced]
fs (Type -> Term -> Elims -> Elims -> Constraint)
-> ReduceM Type -> ReduceM (Term -> Elims -> Elims -> Constraint)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Type -> ReduceM Type
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' Type
t ReduceM (Term -> Elims -> Elims -> Constraint)
-> ReduceM Term -> ReduceM (Elims -> Elims -> Constraint)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Term -> ReduceM Term
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' Term
v ReduceM (Elims -> Elims -> Constraint)
-> ReduceM Elims -> ReduceM (Elims -> Constraint)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Elims -> ReduceM Elims
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' Elims
as ReduceM (Elims -> Constraint)
-> ReduceM Elims -> ReduceM Constraint
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Elims -> ReduceM Elims
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' Elims
bs
LevelCmp cmp :: Comparison
cmp u :: Level
u v :: Level
v -> (Level -> Level -> Constraint) -> (Level, Level) -> Constraint
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (Comparison -> Level -> Level -> Constraint
LevelCmp Comparison
cmp) ((Level, Level) -> Constraint)
-> ReduceM (Level, Level) -> ReduceM Constraint
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Level, Level) -> ReduceM (Level, Level)
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' (Level
u,Level
v)
TelCmp a :: Type
a b :: Type
b cmp :: Comparison
cmp tela :: Telescope
tela telb :: Telescope
telb -> (Telescope -> Telescope -> Constraint)
-> (Telescope, Telescope) -> Constraint
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (Type -> Type -> Comparison -> Telescope -> Telescope -> Constraint
TelCmp Type
a Type
b Comparison
cmp) ((Telescope, Telescope) -> Constraint)
-> ReduceM (Telescope, Telescope) -> ReduceM Constraint
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Telescope, Telescope) -> ReduceM (Telescope, Telescope)
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' (Telescope
tela,Telescope
telb)
SortCmp cmp :: Comparison
cmp a :: Sort
a b :: Sort
b -> (Sort -> Sort -> Constraint) -> (Sort, Sort) -> Constraint
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (Comparison -> Sort -> Sort -> Constraint
SortCmp Comparison
cmp) ((Sort, Sort) -> Constraint)
-> ReduceM (Sort, Sort) -> ReduceM Constraint
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Sort, Sort) -> ReduceM (Sort, Sort)
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' (Sort
a,Sort
b)
Guarded c :: Constraint
c pid :: ProblemId
pid -> Constraint -> ProblemId -> Constraint
Guarded (Constraint -> ProblemId -> Constraint)
-> ReduceM Constraint -> ReduceM (ProblemId -> Constraint)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Constraint -> ReduceM Constraint
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' Constraint
c ReduceM (ProblemId -> Constraint)
-> ReduceM ProblemId -> ReduceM Constraint
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ProblemId -> ReduceM ProblemId
forall (f :: * -> *) a. Applicative f => a -> f a
pure ProblemId
pid
UnBlock m :: MetaId
m -> Constraint -> ReduceM Constraint
forall (m :: * -> *) a. Monad m => a -> m a
return (Constraint -> ReduceM Constraint)
-> Constraint -> ReduceM Constraint
forall a b. (a -> b) -> a -> b
$ MetaId -> Constraint
UnBlock MetaId
m
FindInstance m :: MetaId
m b :: Maybe MetaId
b cands :: Maybe [Candidate]
cands -> MetaId -> Maybe MetaId -> Maybe [Candidate] -> Constraint
FindInstance MetaId
m Maybe MetaId
b (Maybe [Candidate] -> Constraint)
-> ReduceM (Maybe [Candidate]) -> ReduceM Constraint
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Candidate] -> ReduceM [Candidate])
-> Maybe [Candidate] -> ReduceM (Maybe [Candidate])
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM [Candidate] -> ReduceM [Candidate]
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' Maybe [Candidate]
cands
IsEmpty r :: Range
r t :: Type
t -> Range -> Type -> Constraint
IsEmpty Range
r (Type -> Constraint) -> ReduceM Type -> ReduceM Constraint
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Type -> ReduceM Type
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' Type
t
CheckSizeLtSat t :: Term
t -> Term -> Constraint
CheckSizeLtSat (Term -> Constraint) -> ReduceM Term -> ReduceM Constraint
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term -> ReduceM Term
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' Term
t
c :: Constraint
c@CheckFunDef{} -> Constraint -> ReduceM Constraint
forall (m :: * -> *) a. Monad m => a -> m a
return Constraint
c
HasBiggerSort a :: Sort
a -> Sort -> Constraint
HasBiggerSort (Sort -> Constraint) -> ReduceM Sort -> ReduceM Constraint
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sort -> ReduceM Sort
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' Sort
a
HasPTSRule a :: Dom Type
a b :: Abs Sort
b -> (Dom Type -> Abs Sort -> Constraint)
-> (Dom Type, Abs Sort) -> Constraint
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Dom Type -> Abs Sort -> Constraint
HasPTSRule ((Dom Type, Abs Sort) -> Constraint)
-> ReduceM (Dom Type, Abs Sort) -> ReduceM Constraint
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Dom Type, Abs Sort) -> ReduceM (Dom Type, Abs Sort)
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' (Dom Type
a,Abs Sort
b)
UnquoteTactic m :: Maybe MetaId
m t :: Term
t g :: Term
g h :: Type
h -> Maybe MetaId -> Term -> Term -> Type -> Constraint
UnquoteTactic Maybe MetaId
m (Term -> Term -> Type -> Constraint)
-> ReduceM Term -> ReduceM (Term -> Type -> Constraint)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term -> ReduceM Term
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' Term
t ReduceM (Term -> Type -> Constraint)
-> ReduceM Term -> ReduceM (Type -> Constraint)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Term -> ReduceM Term
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' Term
g ReduceM (Type -> Constraint) -> ReduceM Type -> ReduceM Constraint
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Type -> ReduceM Type
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' Type
h
c :: Constraint
c@CheckMetaInst{} -> Constraint -> ReduceM Constraint
forall (m :: * -> *) a. Monad m => a -> m a
return Constraint
c
instance InstantiateFull CompareAs where
instantiateFull' :: CompareAs -> ReduceM CompareAs
instantiateFull' (AsTermsOf a :: Type
a) = Type -> CompareAs
AsTermsOf (Type -> CompareAs) -> ReduceM Type -> ReduceM CompareAs
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Type -> ReduceM Type
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' Type
a
instantiateFull' AsSizes = CompareAs -> ReduceM CompareAs
forall (m :: * -> *) a. Monad m => a -> m a
return CompareAs
AsSizes
instantiateFull' AsTypes = CompareAs -> ReduceM CompareAs
forall (m :: * -> *) a. Monad m => a -> m a
return CompareAs
AsTypes
instance InstantiateFull Signature where
instantiateFull' :: Signature -> ReduceM Signature
instantiateFull' (Sig a :: Sections
a b :: Definitions
b c :: RewriteRuleMap
c) = (Sections -> Definitions -> RewriteRuleMap -> Signature)
-> (Sections, Definitions, RewriteRuleMap) -> Signature
forall a b c d. (a -> b -> c -> d) -> (a, b, c) -> d
uncurry3 Sections -> Definitions -> RewriteRuleMap -> Signature
Sig ((Sections, Definitions, RewriteRuleMap) -> Signature)
-> ReduceM (Sections, Definitions, RewriteRuleMap)
-> ReduceM Signature
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Sections, Definitions, RewriteRuleMap)
-> ReduceM (Sections, Definitions, RewriteRuleMap)
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' (Sections
a, Definitions
b, RewriteRuleMap
c)
instance InstantiateFull Section where
instantiateFull' :: Section -> ReduceM Section
instantiateFull' (Section tel :: Telescope
tel) = Telescope -> Section
Section (Telescope -> Section) -> ReduceM Telescope -> ReduceM Section
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Telescope -> ReduceM Telescope
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' Telescope
tel
instance (Subst t a, InstantiateFull a) => InstantiateFull (Tele a) where
instantiateFull' :: Tele a -> ReduceM (Tele a)
instantiateFull' EmptyTel = Tele a -> ReduceM (Tele a)
forall (m :: * -> *) a. Monad m => a -> m a
return Tele a
forall a. Tele a
EmptyTel
instantiateFull' (ExtendTel a :: a
a b :: Abs (Tele a)
b) = (a -> Abs (Tele a) -> Tele a) -> (a, Abs (Tele a)) -> Tele a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry a -> Abs (Tele a) -> Tele a
forall a. a -> Abs (Tele a) -> Tele a
ExtendTel ((a, Abs (Tele a)) -> Tele a)
-> ReduceM (a, Abs (Tele a)) -> ReduceM (Tele a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a, Abs (Tele a)) -> ReduceM (a, Abs (Tele a))
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' (a
a, Abs (Tele a)
b)
instance InstantiateFull Definition where
instantiateFull' :: Definition -> ReduceM Definition
instantiateFull' def :: Definition
def@Defn{ defType :: Definition -> Type
defType = Type
t ,defDisplay :: Definition -> [LocalDisplayForm]
defDisplay = [LocalDisplayForm]
df, theDef :: Definition -> Defn
theDef = Defn
d } = do
(t :: Type
t, df :: [LocalDisplayForm]
df, d :: Defn
d) <- (Type, [LocalDisplayForm], Defn)
-> ReduceM (Type, [LocalDisplayForm], Defn)
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' (Type
t, [LocalDisplayForm]
df, Defn
d)
Definition -> ReduceM Definition
forall (m :: * -> *) a. Monad m => a -> m a
return (Definition -> ReduceM Definition)
-> Definition -> ReduceM Definition
forall a b. (a -> b) -> a -> b
$ Definition
def{ defType :: Type
defType = Type
t, defDisplay :: [LocalDisplayForm]
defDisplay = [LocalDisplayForm]
df, theDef :: Defn
theDef = Defn
d }
instance InstantiateFull NLPat where
instantiateFull' :: NLPat -> ReduceM NLPat
instantiateFull' (PVar x :: Int
x y :: [Arg Int]
y) = NLPat -> ReduceM NLPat
forall (m :: * -> *) a. Monad m => a -> m a
return (NLPat -> ReduceM NLPat) -> NLPat -> ReduceM NLPat
forall a b. (a -> b) -> a -> b
$ Int -> [Arg Int] -> NLPat
PVar Int
x [Arg Int]
y
instantiateFull' (PDef x :: QName
x y :: PElims
y) = QName -> PElims -> NLPat
PDef (QName -> PElims -> NLPat)
-> ReduceM QName -> ReduceM (PElims -> NLPat)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> QName -> ReduceM QName
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' QName
x ReduceM (PElims -> NLPat) -> ReduceM PElims -> ReduceM NLPat
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> PElims -> ReduceM PElims
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' PElims
y
instantiateFull' (PLam x :: ArgInfo
x y :: Abs NLPat
y) = ArgInfo -> Abs NLPat -> NLPat
PLam ArgInfo
x (Abs NLPat -> NLPat) -> ReduceM (Abs NLPat) -> ReduceM NLPat
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Abs NLPat -> ReduceM (Abs NLPat)
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' Abs NLPat
y
instantiateFull' (PPi x :: Dom NLPType
x y :: Abs NLPType
y) = Dom NLPType -> Abs NLPType -> NLPat
PPi (Dom NLPType -> Abs NLPType -> NLPat)
-> ReduceM (Dom NLPType) -> ReduceM (Abs NLPType -> NLPat)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Dom NLPType -> ReduceM (Dom NLPType)
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' Dom NLPType
x ReduceM (Abs NLPType -> NLPat)
-> ReduceM (Abs NLPType) -> ReduceM NLPat
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Abs NLPType -> ReduceM (Abs NLPType)
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' Abs NLPType
y
instantiateFull' (PSort x :: NLPSort
x) = NLPSort -> NLPat
PSort (NLPSort -> NLPat) -> ReduceM NLPSort -> ReduceM NLPat
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NLPSort -> ReduceM NLPSort
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' NLPSort
x
instantiateFull' (PBoundVar x :: Int
x y :: PElims
y) = Int -> PElims -> NLPat
PBoundVar Int
x (PElims -> NLPat) -> ReduceM PElims -> ReduceM NLPat
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PElims -> ReduceM PElims
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' PElims
y
instantiateFull' (PTerm x :: Term
x) = Term -> NLPat
PTerm (Term -> NLPat) -> ReduceM Term -> ReduceM NLPat
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term -> ReduceM Term
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' Term
x
instance InstantiateFull NLPType where
instantiateFull' :: NLPType -> ReduceM NLPType
instantiateFull' (NLPType s :: NLPSort
s a :: NLPat
a) = NLPSort -> NLPat -> NLPType
NLPType
(NLPSort -> NLPat -> NLPType)
-> ReduceM NLPSort -> ReduceM (NLPat -> NLPType)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NLPSort -> ReduceM NLPSort
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' NLPSort
s
ReduceM (NLPat -> NLPType) -> ReduceM NLPat -> ReduceM NLPType
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> NLPat -> ReduceM NLPat
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' NLPat
a
instance InstantiateFull NLPSort where
instantiateFull' :: NLPSort -> ReduceM NLPSort
instantiateFull' (PType x :: NLPat
x) = NLPat -> NLPSort
PType (NLPat -> NLPSort) -> ReduceM NLPat -> ReduceM NLPSort
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NLPat -> ReduceM NLPat
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' NLPat
x
instantiateFull' (PProp x :: NLPat
x) = NLPat -> NLPSort
PProp (NLPat -> NLPSort) -> ReduceM NLPat -> ReduceM NLPSort
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NLPat -> ReduceM NLPat
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' NLPat
x
instantiateFull' PInf = NLPSort -> ReduceM NLPSort
forall (m :: * -> *) a. Monad m => a -> m a
return NLPSort
PInf
instantiateFull' PSizeUniv = NLPSort -> ReduceM NLPSort
forall (m :: * -> *) a. Monad m => a -> m a
return NLPSort
PSizeUniv
instance InstantiateFull RewriteRule where
instantiateFull' :: RewriteRule -> ReduceM RewriteRule
instantiateFull' (RewriteRule q :: QName
q gamma :: Telescope
gamma f :: QName
f ps :: PElims
ps rhs :: Term
rhs t :: Type
t) =
QName
-> Telescope -> QName -> PElims -> Term -> Type -> RewriteRule
RewriteRule QName
q
(Telescope -> QName -> PElims -> Term -> Type -> RewriteRule)
-> ReduceM Telescope
-> ReduceM (QName -> PElims -> Term -> Type -> RewriteRule)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Telescope -> ReduceM Telescope
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' Telescope
gamma
ReduceM (QName -> PElims -> Term -> Type -> RewriteRule)
-> ReduceM QName -> ReduceM (PElims -> Term -> Type -> RewriteRule)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> QName -> ReduceM QName
forall (f :: * -> *) a. Applicative f => a -> f a
pure QName
f
ReduceM (PElims -> Term -> Type -> RewriteRule)
-> ReduceM PElims -> ReduceM (Term -> Type -> RewriteRule)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> PElims -> ReduceM PElims
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' PElims
ps
ReduceM (Term -> Type -> RewriteRule)
-> ReduceM Term -> ReduceM (Type -> RewriteRule)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Term -> ReduceM Term
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' Term
rhs
ReduceM (Type -> RewriteRule)
-> ReduceM Type -> ReduceM RewriteRule
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Type -> ReduceM Type
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' Type
t
instance InstantiateFull DisplayForm where
instantiateFull' :: DisplayForm -> ReduceM DisplayForm
instantiateFull' (Display n :: Int
n ps :: Elims
ps v :: DisplayTerm
v) = (Elims -> DisplayTerm -> DisplayForm)
-> (Elims, DisplayTerm) -> DisplayForm
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (Int -> Elims -> DisplayTerm -> DisplayForm
Display Int
n) ((Elims, DisplayTerm) -> DisplayForm)
-> ReduceM (Elims, DisplayTerm) -> ReduceM DisplayForm
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Elims, DisplayTerm) -> ReduceM (Elims, DisplayTerm)
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' (Elims
ps, DisplayTerm
v)
instance InstantiateFull DisplayTerm where
instantiateFull' :: DisplayTerm -> ReduceM DisplayTerm
instantiateFull' (DTerm v :: Term
v) = Term -> DisplayTerm
DTerm (Term -> DisplayTerm) -> ReduceM Term -> ReduceM DisplayTerm
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term -> ReduceM Term
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' Term
v
instantiateFull' (DDot v :: Term
v) = Term -> DisplayTerm
DDot (Term -> DisplayTerm) -> ReduceM Term -> ReduceM DisplayTerm
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term -> ReduceM Term
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' Term
v
instantiateFull' (DCon c :: ConHead
c ci :: ConInfo
ci vs :: [Arg DisplayTerm]
vs) = ConHead -> ConInfo -> [Arg DisplayTerm] -> DisplayTerm
DCon ConHead
c ConInfo
ci ([Arg DisplayTerm] -> DisplayTerm)
-> ReduceM [Arg DisplayTerm] -> ReduceM DisplayTerm
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Arg DisplayTerm] -> ReduceM [Arg DisplayTerm]
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' [Arg DisplayTerm]
vs
instantiateFull' (DDef c :: QName
c es :: [Elim' DisplayTerm]
es) = QName -> [Elim' DisplayTerm] -> DisplayTerm
DDef QName
c ([Elim' DisplayTerm] -> DisplayTerm)
-> ReduceM [Elim' DisplayTerm] -> ReduceM DisplayTerm
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Elim' DisplayTerm] -> ReduceM [Elim' DisplayTerm]
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' [Elim' DisplayTerm]
es
instantiateFull' (DWithApp v :: DisplayTerm
v vs :: [DisplayTerm]
vs ws :: Elims
ws) = (DisplayTerm -> [DisplayTerm] -> Elims -> DisplayTerm)
-> (DisplayTerm, [DisplayTerm], Elims) -> DisplayTerm
forall a b c d. (a -> b -> c -> d) -> (a, b, c) -> d
uncurry3 DisplayTerm -> [DisplayTerm] -> Elims -> DisplayTerm
DWithApp ((DisplayTerm, [DisplayTerm], Elims) -> DisplayTerm)
-> ReduceM (DisplayTerm, [DisplayTerm], Elims)
-> ReduceM DisplayTerm
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DisplayTerm, [DisplayTerm], Elims)
-> ReduceM (DisplayTerm, [DisplayTerm], Elims)
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' (DisplayTerm
v, [DisplayTerm]
vs, Elims
ws)
instance InstantiateFull Defn where
instantiateFull' :: Defn -> ReduceM Defn
instantiateFull' d :: Defn
d = case Defn
d of
Axiom{} -> Defn -> ReduceM Defn
forall (m :: * -> *) a. Monad m => a -> m a
return Defn
d
DataOrRecSig{} -> Defn -> ReduceM Defn
forall (m :: * -> *) a. Monad m => a -> m a
return Defn
d
GeneralizableVar{} -> Defn -> ReduceM Defn
forall (m :: * -> *) a. Monad m => a -> m a
return Defn
d
AbstractDefn d :: Defn
d -> Defn -> Defn
AbstractDefn (Defn -> Defn) -> ReduceM Defn -> ReduceM Defn
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Defn -> ReduceM Defn
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' Defn
d
Function{ funClauses :: Defn -> [Clause]
funClauses = [Clause]
cs, funCompiled :: Defn -> Maybe CompiledClauses
funCompiled = Maybe CompiledClauses
cc, funCovering :: Defn -> [Clause]
funCovering = [Clause]
cov, funInv :: Defn -> FunctionInverse
funInv = FunctionInverse
inv, funExtLam :: Defn -> Maybe ExtLamInfo
funExtLam = Maybe ExtLamInfo
extLam } -> do
(cs :: [Clause]
cs, cc :: Maybe CompiledClauses
cc, cov :: [Clause]
cov, inv :: FunctionInverse
inv) <- ([Clause], Maybe CompiledClauses, [Clause], FunctionInverse)
-> ReduceM
([Clause], Maybe CompiledClauses, [Clause], FunctionInverse)
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' ([Clause]
cs, Maybe CompiledClauses
cc, [Clause]
cov, FunctionInverse
inv)
Maybe ExtLamInfo
extLam <- Maybe ExtLamInfo -> ReduceM (Maybe ExtLamInfo)
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' Maybe ExtLamInfo
extLam
Defn -> ReduceM Defn
forall (m :: * -> *) a. Monad m => a -> m a
return (Defn -> ReduceM Defn) -> Defn -> ReduceM Defn
forall a b. (a -> b) -> a -> b
$ Defn
d { funClauses :: [Clause]
funClauses = [Clause]
cs, funCompiled :: Maybe CompiledClauses
funCompiled = Maybe CompiledClauses
cc, funCovering :: [Clause]
funCovering = [Clause]
cov, funInv :: FunctionInverse
funInv = FunctionInverse
inv, funExtLam :: Maybe ExtLamInfo
funExtLam = Maybe ExtLamInfo
extLam }
Datatype{ dataSort :: Defn -> Sort
dataSort = Sort
s, dataClause :: Defn -> Maybe Clause
dataClause = Maybe Clause
cl } -> do
Sort
s <- Sort -> ReduceM Sort
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' Sort
s
Maybe Clause
cl <- Maybe Clause -> ReduceM (Maybe Clause)
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' Maybe Clause
cl
Defn -> ReduceM Defn
forall (m :: * -> *) a. Monad m => a -> m a
return (Defn -> ReduceM Defn) -> Defn -> ReduceM Defn
forall a b. (a -> b) -> a -> b
$ Defn
d { dataSort :: Sort
dataSort = Sort
s, dataClause :: Maybe Clause
dataClause = Maybe Clause
cl }
Record{ recClause :: Defn -> Maybe Clause
recClause = Maybe Clause
cl, recTel :: Defn -> Telescope
recTel = Telescope
tel } -> do
Maybe Clause
cl <- Maybe Clause -> ReduceM (Maybe Clause)
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' Maybe Clause
cl
Telescope
tel <- Telescope -> ReduceM Telescope
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' Telescope
tel
Defn -> ReduceM Defn
forall (m :: * -> *) a. Monad m => a -> m a
return (Defn -> ReduceM Defn) -> Defn -> ReduceM Defn
forall a b. (a -> b) -> a -> b
$ Defn
d { recClause :: Maybe Clause
recClause = Maybe Clause
cl, recTel :: Telescope
recTel = Telescope
tel }
Constructor{} -> Defn -> ReduceM Defn
forall (m :: * -> *) a. Monad m => a -> m a
return Defn
d
Primitive{ primClauses :: Defn -> [Clause]
primClauses = [Clause]
cs } -> do
[Clause]
cs <- [Clause] -> ReduceM [Clause]
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' [Clause]
cs
Defn -> ReduceM Defn
forall (m :: * -> *) a. Monad m => a -> m a
return (Defn -> ReduceM Defn) -> Defn -> ReduceM Defn
forall a b. (a -> b) -> a -> b
$ Defn
d { primClauses :: [Clause]
primClauses = [Clause]
cs }
instance InstantiateFull ExtLamInfo where
instantiateFull' :: ExtLamInfo -> ReduceM ExtLamInfo
instantiateFull' e :: ExtLamInfo
e@(ExtLamInfo { extLamSys :: ExtLamInfo -> Maybe System
extLamSys = Maybe System
sys}) = do
Maybe System
sys <- Maybe System -> ReduceM (Maybe System)
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' Maybe System
sys
ExtLamInfo -> ReduceM ExtLamInfo
forall (m :: * -> *) a. Monad m => a -> m a
return (ExtLamInfo -> ReduceM ExtLamInfo)
-> ExtLamInfo -> ReduceM ExtLamInfo
forall a b. (a -> b) -> a -> b
$ ExtLamInfo
e { extLamSys :: Maybe System
extLamSys = Maybe System
sys}
instance InstantiateFull System where
instantiateFull' :: System -> ReduceM System
instantiateFull' (System tel :: Telescope
tel sys :: [(Face, Term)]
sys) = Telescope -> [(Face, Term)] -> System
System (Telescope -> [(Face, Term)] -> System)
-> ReduceM Telescope -> ReduceM ([(Face, Term)] -> System)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Telescope -> ReduceM Telescope
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' Telescope
tel ReduceM ([(Face, Term)] -> System)
-> ReduceM [(Face, Term)] -> ReduceM System
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [(Face, Term)] -> ReduceM [(Face, Term)]
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' [(Face, Term)]
sys
instance InstantiateFull FunctionInverse where
instantiateFull' :: FunctionInverse -> ReduceM FunctionInverse
instantiateFull' NotInjective = FunctionInverse -> ReduceM FunctionInverse
forall (m :: * -> *) a. Monad m => a -> m a
return FunctionInverse
forall c. FunctionInverse' c
NotInjective
instantiateFull' (Inverse inv :: InversionMap Clause
inv) = InversionMap Clause -> FunctionInverse
forall c. InversionMap c -> FunctionInverse' c
Inverse (InversionMap Clause -> FunctionInverse)
-> ReduceM (InversionMap Clause) -> ReduceM FunctionInverse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> InversionMap Clause -> ReduceM (InversionMap Clause)
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' InversionMap Clause
inv
instance InstantiateFull a => InstantiateFull (Case a) where
instantiateFull' :: Case a -> ReduceM (Case a)
instantiateFull' (Branches cop :: Bool
cop cs :: Map QName (WithArity a)
cs eta :: Maybe (ConHead, WithArity a)
eta ls :: Map Literal a
ls m :: Maybe a
m b :: Maybe Bool
b lz :: Bool
lz) =
Bool
-> Map QName (WithArity a)
-> Maybe (ConHead, WithArity a)
-> Map Literal a
-> Maybe a
-> Maybe Bool
-> Bool
-> Case a
forall c.
Bool
-> Map QName (WithArity c)
-> Maybe (ConHead, WithArity c)
-> Map Literal c
-> Maybe c
-> Maybe Bool
-> Bool
-> Case c
Branches Bool
cop
(Map QName (WithArity a)
-> Maybe (ConHead, WithArity a)
-> Map Literal a
-> Maybe a
-> Maybe Bool
-> Bool
-> Case a)
-> ReduceM (Map QName (WithArity a))
-> ReduceM
(Maybe (ConHead, WithArity a)
-> Map Literal a -> Maybe a -> Maybe Bool -> Bool -> Case a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map QName (WithArity a) -> ReduceM (Map QName (WithArity a))
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' Map QName (WithArity a)
cs
ReduceM
(Maybe (ConHead, WithArity a)
-> Map Literal a -> Maybe a -> Maybe Bool -> Bool -> Case a)
-> ReduceM (Maybe (ConHead, WithArity a))
-> ReduceM
(Map Literal a -> Maybe a -> Maybe Bool -> Bool -> Case a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe (ConHead, WithArity a)
-> ReduceM (Maybe (ConHead, WithArity a))
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' Maybe (ConHead, WithArity a)
eta
ReduceM (Map Literal a -> Maybe a -> Maybe Bool -> Bool -> Case a)
-> ReduceM (Map Literal a)
-> ReduceM (Maybe a -> Maybe Bool -> Bool -> Case a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Map Literal a -> ReduceM (Map Literal a)
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' Map Literal a
ls
ReduceM (Maybe a -> Maybe Bool -> Bool -> Case a)
-> ReduceM (Maybe a) -> ReduceM (Maybe Bool -> Bool -> Case a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe a -> ReduceM (Maybe a)
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' Maybe a
m
ReduceM (Maybe Bool -> Bool -> Case a)
-> ReduceM (Maybe Bool) -> ReduceM (Bool -> Case a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe Bool -> ReduceM (Maybe Bool)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Bool
b
ReduceM (Bool -> Case a) -> ReduceM Bool -> ReduceM (Case a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Bool -> ReduceM Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
lz
instance InstantiateFull CompiledClauses where
instantiateFull' :: CompiledClauses -> ReduceM CompiledClauses
instantiateFull' Fail = CompiledClauses -> ReduceM CompiledClauses
forall (m :: * -> *) a. Monad m => a -> m a
return CompiledClauses
forall a. CompiledClauses' a
Fail
instantiateFull' (Done m :: [Arg String]
m t :: Term
t) = [Arg String] -> Term -> CompiledClauses
forall a. [Arg String] -> a -> CompiledClauses' a
Done [Arg String]
m (Term -> CompiledClauses)
-> ReduceM Term -> ReduceM CompiledClauses
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term -> ReduceM Term
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' Term
t
instantiateFull' (Case n :: Arg Int
n bs :: Case CompiledClauses
bs) = Arg Int -> Case CompiledClauses -> CompiledClauses
forall a.
Arg Int -> Case (CompiledClauses' a) -> CompiledClauses' a
Case Arg Int
n (Case CompiledClauses -> CompiledClauses)
-> ReduceM (Case CompiledClauses) -> ReduceM CompiledClauses
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Case CompiledClauses -> ReduceM (Case CompiledClauses)
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' Case CompiledClauses
bs
instance InstantiateFull Clause where
instantiateFull' :: Clause -> ReduceM Clause
instantiateFull' (Clause rl :: Range
rl rf :: Range
rf tel :: Telescope
tel ps :: NAPs
ps b :: Maybe Term
b t :: Maybe (Arg Type)
t catchall :: Bool
catchall recursive :: Maybe Bool
recursive unreachable :: Maybe Bool
unreachable ell :: ExpandedEllipsis
ell) =
Range
-> Range
-> Telescope
-> NAPs
-> Maybe Term
-> Maybe (Arg Type)
-> Bool
-> Maybe Bool
-> Maybe Bool
-> ExpandedEllipsis
-> Clause
Clause Range
rl Range
rf (Telescope
-> NAPs
-> Maybe Term
-> Maybe (Arg Type)
-> Bool
-> Maybe Bool
-> Maybe Bool
-> ExpandedEllipsis
-> Clause)
-> ReduceM Telescope
-> ReduceM
(NAPs
-> Maybe Term
-> Maybe (Arg Type)
-> Bool
-> Maybe Bool
-> Maybe Bool
-> ExpandedEllipsis
-> Clause)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Telescope -> ReduceM Telescope
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' Telescope
tel
ReduceM
(NAPs
-> Maybe Term
-> Maybe (Arg Type)
-> Bool
-> Maybe Bool
-> Maybe Bool
-> ExpandedEllipsis
-> Clause)
-> ReduceM NAPs
-> ReduceM
(Maybe Term
-> Maybe (Arg Type)
-> Bool
-> Maybe Bool
-> Maybe Bool
-> ExpandedEllipsis
-> Clause)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> NAPs -> ReduceM NAPs
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' NAPs
ps
ReduceM
(Maybe Term
-> Maybe (Arg Type)
-> Bool
-> Maybe Bool
-> Maybe Bool
-> ExpandedEllipsis
-> Clause)
-> ReduceM (Maybe Term)
-> ReduceM
(Maybe (Arg Type)
-> Bool -> Maybe Bool -> Maybe Bool -> ExpandedEllipsis -> Clause)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe Term -> ReduceM (Maybe Term)
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' Maybe Term
b
ReduceM
(Maybe (Arg Type)
-> Bool -> Maybe Bool -> Maybe Bool -> ExpandedEllipsis -> Clause)
-> ReduceM (Maybe (Arg Type))
-> ReduceM
(Bool -> Maybe Bool -> Maybe Bool -> ExpandedEllipsis -> Clause)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe (Arg Type) -> ReduceM (Maybe (Arg Type))
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' Maybe (Arg Type)
t
ReduceM
(Bool -> Maybe Bool -> Maybe Bool -> ExpandedEllipsis -> Clause)
-> ReduceM Bool
-> ReduceM (Maybe Bool -> Maybe Bool -> ExpandedEllipsis -> Clause)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Bool -> ReduceM Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
catchall
ReduceM (Maybe Bool -> Maybe Bool -> ExpandedEllipsis -> Clause)
-> ReduceM (Maybe Bool)
-> ReduceM (Maybe Bool -> ExpandedEllipsis -> Clause)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe Bool -> ReduceM (Maybe Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Bool
recursive
ReduceM (Maybe Bool -> ExpandedEllipsis -> Clause)
-> ReduceM (Maybe Bool) -> ReduceM (ExpandedEllipsis -> Clause)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe Bool -> ReduceM (Maybe Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Bool
unreachable
ReduceM (ExpandedEllipsis -> Clause)
-> ReduceM ExpandedEllipsis -> ReduceM Clause
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ExpandedEllipsis -> ReduceM ExpandedEllipsis
forall (m :: * -> *) a. Monad m => a -> m a
return ExpandedEllipsis
ell
instance InstantiateFull Interface where
instantiateFull' :: Interface -> ReduceM Interface
instantiateFull' (Interface h :: Hash
h s :: Text
s ft :: FileType
ft ms :: [(ModuleName, Hash)]
ms mod :: ModuleName
mod scope :: Map ModuleName Scope
scope inside :: ScopeInfo
inside
sig :: Signature
sig display :: DisplayForms
display userwarn :: Map QName String
userwarn importwarn :: Maybe String
importwarn b :: BuiltinThings (String, QName)
b foreignCode :: Map String [ForeignCode]
foreignCode
highlighting :: HighlightingInfo
highlighting pragmas :: [OptionsPragma]
pragmas usedOpts :: PragmaOptions
usedOpts patsyns :: PatternSynDefns
patsyns warnings :: [TCWarning]
warnings partialdefs :: Set QName
partialdefs) =
Hash
-> Text
-> FileType
-> [(ModuleName, Hash)]
-> ModuleName
-> Map ModuleName Scope
-> ScopeInfo
-> Signature
-> DisplayForms
-> Map QName String
-> Maybe String
-> BuiltinThings (String, QName)
-> Map String [ForeignCode]
-> HighlightingInfo
-> [OptionsPragma]
-> PragmaOptions
-> PatternSynDefns
-> [TCWarning]
-> Set QName
-> Interface
Interface Hash
h Text
s FileType
ft [(ModuleName, Hash)]
ms ModuleName
mod Map ModuleName Scope
scope ScopeInfo
inside
(Signature
-> DisplayForms
-> Map QName String
-> Maybe String
-> BuiltinThings (String, QName)
-> Map String [ForeignCode]
-> HighlightingInfo
-> [OptionsPragma]
-> PragmaOptions
-> PatternSynDefns
-> [TCWarning]
-> Set QName
-> Interface)
-> ReduceM Signature
-> ReduceM
(DisplayForms
-> Map QName String
-> Maybe String
-> BuiltinThings (String, QName)
-> Map String [ForeignCode]
-> HighlightingInfo
-> [OptionsPragma]
-> PragmaOptions
-> PatternSynDefns
-> [TCWarning]
-> Set QName
-> Interface)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Signature -> ReduceM Signature
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' Signature
sig
ReduceM
(DisplayForms
-> Map QName String
-> Maybe String
-> BuiltinThings (String, QName)
-> Map String [ForeignCode]
-> HighlightingInfo
-> [OptionsPragma]
-> PragmaOptions
-> PatternSynDefns
-> [TCWarning]
-> Set QName
-> Interface)
-> ReduceM DisplayForms
-> ReduceM
(Map QName String
-> Maybe String
-> BuiltinThings (String, QName)
-> Map String [ForeignCode]
-> HighlightingInfo
-> [OptionsPragma]
-> PragmaOptions
-> PatternSynDefns
-> [TCWarning]
-> Set QName
-> Interface)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> DisplayForms -> ReduceM DisplayForms
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' DisplayForms
display
ReduceM
(Map QName String
-> Maybe String
-> BuiltinThings (String, QName)
-> Map String [ForeignCode]
-> HighlightingInfo
-> [OptionsPragma]
-> PragmaOptions
-> PatternSynDefns
-> [TCWarning]
-> Set QName
-> Interface)
-> ReduceM (Map QName String)
-> ReduceM
(Maybe String
-> BuiltinThings (String, QName)
-> Map String [ForeignCode]
-> HighlightingInfo
-> [OptionsPragma]
-> PragmaOptions
-> PatternSynDefns
-> [TCWarning]
-> Set QName
-> Interface)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Map QName String -> ReduceM (Map QName String)
forall (m :: * -> *) a. Monad m => a -> m a
return Map QName String
userwarn
ReduceM
(Maybe String
-> BuiltinThings (String, QName)
-> Map String [ForeignCode]
-> HighlightingInfo
-> [OptionsPragma]
-> PragmaOptions
-> PatternSynDefns
-> [TCWarning]
-> Set QName
-> Interface)
-> ReduceM (Maybe String)
-> ReduceM
(BuiltinThings (String, QName)
-> Map String [ForeignCode]
-> HighlightingInfo
-> [OptionsPragma]
-> PragmaOptions
-> PatternSynDefns
-> [TCWarning]
-> Set QName
-> Interface)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe String -> ReduceM (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe String
importwarn
ReduceM
(BuiltinThings (String, QName)
-> Map String [ForeignCode]
-> HighlightingInfo
-> [OptionsPragma]
-> PragmaOptions
-> PatternSynDefns
-> [TCWarning]
-> Set QName
-> Interface)
-> ReduceM (BuiltinThings (String, QName))
-> ReduceM
(Map String [ForeignCode]
-> HighlightingInfo
-> [OptionsPragma]
-> PragmaOptions
-> PatternSynDefns
-> [TCWarning]
-> Set QName
-> Interface)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BuiltinThings (String, QName)
-> ReduceM (BuiltinThings (String, QName))
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' BuiltinThings (String, QName)
b
ReduceM
(Map String [ForeignCode]
-> HighlightingInfo
-> [OptionsPragma]
-> PragmaOptions
-> PatternSynDefns
-> [TCWarning]
-> Set QName
-> Interface)
-> ReduceM (Map String [ForeignCode])
-> ReduceM
(HighlightingInfo
-> [OptionsPragma]
-> PragmaOptions
-> PatternSynDefns
-> [TCWarning]
-> Set QName
-> Interface)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Map String [ForeignCode] -> ReduceM (Map String [ForeignCode])
forall (m :: * -> *) a. Monad m => a -> m a
return Map String [ForeignCode]
foreignCode
ReduceM
(HighlightingInfo
-> [OptionsPragma]
-> PragmaOptions
-> PatternSynDefns
-> [TCWarning]
-> Set QName
-> Interface)
-> ReduceM HighlightingInfo
-> ReduceM
([OptionsPragma]
-> PragmaOptions
-> PatternSynDefns
-> [TCWarning]
-> Set QName
-> Interface)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> HighlightingInfo -> ReduceM HighlightingInfo
forall (m :: * -> *) a. Monad m => a -> m a
return HighlightingInfo
highlighting
ReduceM
([OptionsPragma]
-> PragmaOptions
-> PatternSynDefns
-> [TCWarning]
-> Set QName
-> Interface)
-> ReduceM [OptionsPragma]
-> ReduceM
(PragmaOptions
-> PatternSynDefns -> [TCWarning] -> Set QName -> Interface)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [OptionsPragma] -> ReduceM [OptionsPragma]
forall (m :: * -> *) a. Monad m => a -> m a
return [OptionsPragma]
pragmas
ReduceM
(PragmaOptions
-> PatternSynDefns -> [TCWarning] -> Set QName -> Interface)
-> ReduceM PragmaOptions
-> ReduceM
(PatternSynDefns -> [TCWarning] -> Set QName -> Interface)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> PragmaOptions -> ReduceM PragmaOptions
forall (m :: * -> *) a. Monad m => a -> m a
return PragmaOptions
usedOpts
ReduceM (PatternSynDefns -> [TCWarning] -> Set QName -> Interface)
-> ReduceM PatternSynDefns
-> ReduceM ([TCWarning] -> Set QName -> Interface)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> PatternSynDefns -> ReduceM PatternSynDefns
forall (m :: * -> *) a. Monad m => a -> m a
return PatternSynDefns
patsyns
ReduceM ([TCWarning] -> Set QName -> Interface)
-> ReduceM [TCWarning] -> ReduceM (Set QName -> Interface)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [TCWarning] -> ReduceM [TCWarning]
forall (m :: * -> *) a. Monad m => a -> m a
return [TCWarning]
warnings
ReduceM (Set QName -> Interface)
-> ReduceM (Set QName) -> ReduceM Interface
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Set QName -> ReduceM (Set QName)
forall (m :: * -> *) a. Monad m => a -> m a
return Set QName
partialdefs
instance InstantiateFull a => InstantiateFull (Builtin a) where
instantiateFull' :: Builtin a -> ReduceM (Builtin a)
instantiateFull' (Builtin t :: Term
t) = Term -> Builtin a
forall pf. Term -> Builtin pf
Builtin (Term -> Builtin a) -> ReduceM Term -> ReduceM (Builtin a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term -> ReduceM Term
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' Term
t
instantiateFull' (Prim x :: a
x) = a -> Builtin a
forall pf. pf -> Builtin pf
Prim (a -> Builtin a) -> ReduceM a -> ReduceM (Builtin a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> ReduceM a
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' a
x
instance InstantiateFull Candidate where
instantiateFull' :: Candidate -> ReduceM Candidate
instantiateFull' (Candidate u :: Term
u t :: Type
t ov :: Bool
ov) =
Term -> Type -> Bool -> Candidate
Candidate (Term -> Type -> Bool -> Candidate)
-> ReduceM Term -> ReduceM (Type -> Bool -> Candidate)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term -> ReduceM Term
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' Term
u ReduceM (Type -> Bool -> Candidate)
-> ReduceM Type -> ReduceM (Bool -> Candidate)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Type -> ReduceM Type
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' Type
t ReduceM (Bool -> Candidate) -> ReduceM Bool -> ReduceM Candidate
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Bool -> ReduceM Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
ov
instance InstantiateFull EqualityView where
instantiateFull' :: EqualityView -> ReduceM EqualityView
instantiateFull' (OtherType t :: Type
t) = Type -> EqualityView
OtherType
(Type -> EqualityView) -> ReduceM Type -> ReduceM EqualityView
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Type -> ReduceM Type
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' Type
t
instantiateFull' (EqualityType s :: Sort
s eq :: QName
eq l :: [Arg Term]
l t :: Arg Term
t a :: Arg Term
a b :: Arg Term
b) = Sort
-> QName
-> [Arg Term]
-> Arg Term
-> Arg Term
-> Arg Term
-> EqualityView
EqualityType
(Sort
-> QName
-> [Arg Term]
-> Arg Term
-> Arg Term
-> Arg Term
-> EqualityView)
-> ReduceM Sort
-> ReduceM
(QName
-> [Arg Term] -> Arg Term -> Arg Term -> Arg Term -> EqualityView)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sort -> ReduceM Sort
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' Sort
s
ReduceM
(QName
-> [Arg Term] -> Arg Term -> Arg Term -> Arg Term -> EqualityView)
-> ReduceM QName
-> ReduceM
([Arg Term] -> Arg Term -> Arg Term -> Arg Term -> EqualityView)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> QName -> ReduceM QName
forall (m :: * -> *) a. Monad m => a -> m a
return QName
eq
ReduceM
([Arg Term] -> Arg Term -> Arg Term -> Arg Term -> EqualityView)
-> ReduceM [Arg Term]
-> ReduceM (Arg Term -> Arg Term -> Arg Term -> EqualityView)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Arg Term -> ReduceM (Arg Term))
-> [Arg Term] -> ReduceM [Arg Term]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Arg Term -> ReduceM (Arg Term)
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' [Arg Term]
l
ReduceM (Arg Term -> Arg Term -> Arg Term -> EqualityView)
-> ReduceM (Arg Term)
-> ReduceM (Arg Term -> Arg Term -> EqualityView)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Arg Term -> ReduceM (Arg Term)
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' Arg Term
t
ReduceM (Arg Term -> Arg Term -> EqualityView)
-> ReduceM (Arg Term) -> ReduceM (Arg Term -> EqualityView)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Arg Term -> ReduceM (Arg Term)
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' Arg Term
a
ReduceM (Arg Term -> EqualityView)
-> ReduceM (Arg Term) -> ReduceM EqualityView
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Arg Term -> ReduceM (Arg Term)
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' Arg Term
b