{-# LANGUAGE NondecreasingIndentation #-}
module Agda.TypeChecking.Reduce
( Instantiate, instantiate', instantiate, instantiateWhen
, InstantiateFull, instantiateFull', instantiateFull
, IsMeta, isMeta
, Reduce, reduce', reduceB', reduce, reduceB, reduceWithBlocker, reduceIApply'
, reduceDefCopy, reduceDefCopyTCM
, reduceHead
, slowReduceTerm
, unfoldCorecursion, unfoldCorecursionE
, unfoldDefinitionE, unfoldDefinitionStep
, unfoldInlined
, appDef', appDefE'
, abortIfBlocked, ifBlocked, isBlocked, fromBlocked, blockOnError
, Simplify, simplify, simplifyBlocked'
, Normalise, normalise', normalise
, slowNormaliseArgs
) where
import Control.Monad ( (>=>), void )
import Control.Monad.Except
import Data.List ( intercalate )
import Data.Maybe
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Foldable
import Data.Traversable
import Data.HashMap.Strict (HashMap)
import qualified Data.Set as Set
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 (isPropM)
import Agda.TypeChecking.Monad hiding ( enterClosure, constructorForm )
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 {-# SOURCE #-} Agda.TypeChecking.Opacity
import Agda.Utils.Functor
import Agda.Utils.Lens
import Agda.Utils.List
import qualified Agda.Utils.Maybe.Strict as Strict
import Agda.Utils.Monad
import Agda.Syntax.Common.Pretty (prettyShow)
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 :: forall a (m :: * -> *). (Instantiate a, MonadReduce m) => a -> m a
instantiate = ReduceM a -> m a
forall a. 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 :: forall a (m :: * -> *).
(InstantiateFull a, MonadReduce m) =>
a -> m a
instantiateFull = ReduceM a -> m a
forall a. 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'
instantiateWhen ::
(InstantiateFull a, MonadReduce m) =>
(MetaId -> ReduceM Bool) ->
a -> m a
instantiateWhen :: forall a (m :: * -> *).
(InstantiateFull a, MonadReduce m) =>
(MetaId -> ReduceM Bool) -> a -> m a
instantiateWhen MetaId -> ReduceM Bool
p =
ReduceM a -> m a
forall a. 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
.
(ReduceEnv -> ReduceEnv) -> ReduceM a -> ReduceM a
forall a. (ReduceEnv -> ReduceEnv) -> ReduceM a -> ReduceM a
localR (\ReduceEnv
env -> ReduceEnv
env { redPred = Just p }) (ReduceM a -> ReduceM a) -> (a -> ReduceM a) -> a -> ReduceM a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
a -> ReduceM a
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull'
{-# INLINE reduce #-}
reduce :: (Reduce a, MonadReduce m) => a -> m a
reduce :: forall a (m :: * -> *). (Reduce a, MonadReduce m) => a -> m a
reduce = ReduceM a -> m a
forall a. 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'
{-# INLINE reduceB #-}
reduceB :: (Reduce a, MonadReduce m) => a -> m (Blocked a)
reduceB :: forall a (m :: * -> *).
(Reduce a, MonadReduce m) =>
a -> m (Blocked a)
reduceB = ReduceM (Blocked a) -> m (Blocked a)
forall a. ReduceM a -> m 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'
reduceWithBlocker :: (Reduce a, IsMeta a, MonadReduce m) => a -> m (Blocker, a)
reduceWithBlocker :: forall a (m :: * -> *).
(Reduce a, IsMeta a, MonadReduce m) =>
a -> m (Blocker, a)
reduceWithBlocker a
a = a
-> (Blocker -> a -> m (Blocker, a))
-> (NotBlocked -> a -> m (Blocker, a))
-> m (Blocker, a)
forall t (m :: * -> *) a.
(Reduce t, IsMeta t, MonadReduce m) =>
t -> (Blocker -> t -> m a) -> (NotBlocked -> t -> m a) -> m a
ifBlocked a
a
(\Blocker
b a
a' -> (Blocker, a) -> m (Blocker, a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocker
b, a
a'))
(\NotBlocked
_ a
a' -> (Blocker, a) -> m (Blocker, a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocker
neverUnblock, a
a'))
{-# INLINE normalise #-}
normalise :: (Normalise a, MonadReduce m) => a -> m a
normalise :: forall a (m :: * -> *). (Normalise a, MonadReduce m) => a -> m a
normalise = ReduceM a -> m a
forall a. 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'
{-# INLINE simplify #-}
simplify :: (Simplify a, MonadReduce m) => a -> m a
simplify :: forall a (m :: * -> *). (Simplify a, MonadReduce m) => a -> m a
simplify = ReduceM a -> m a
forall a. 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 MetaId
m = do
inst <- MetaId -> TCMT IO MetaInstantiation
forall (m :: * -> *).
ReadTCState m =>
MetaId -> m MetaInstantiation
lookupMetaInstantiation MetaId
m
case inst of
InstV Instantiation
inst -> Term -> Bool
forall a. AllMetas 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 (Instantiation -> Term
instBody Instantiation
inst)
MetaInstantiation
_ -> Bool -> TCM Bool
forall a. a -> TCMT IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
{-# INLINABLE blockAll #-}
blockAll :: (Functor f, Foldable f) => f (Blocked a) -> Blocked (f a)
blockAll :: forall (f :: * -> *) a.
(Functor f, Foldable f) =>
f (Blocked a) -> Blocked (f a)
blockAll f (Blocked a)
bs = Blocker -> f a -> Blocked' Term (f a)
forall a t. Blocker -> a -> Blocked' t a
blockedOn Blocker
block (f a -> Blocked' Term (f a)) -> f a -> Blocked' Term (f a)
forall a b. (a -> b) -> a -> b
$ (Blocked a -> a) -> f (Blocked a) -> f a
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Blocked a -> a
forall t a. Blocked' t a -> a
ignoreBlocking f (Blocked a)
bs
where block :: Blocker
block = Set Blocker -> Blocker
unblockOnAll (Set Blocker -> Blocker) -> Set Blocker -> Blocker
forall a b. (a -> b) -> a -> b
$ (Blocked a -> Set Blocker) -> f (Blocked a) -> Set Blocker
forall m a. Monoid m => (a -> m) -> f a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Blocker -> Set Blocker
forall a. a -> Set a
Set.singleton (Blocker -> Set Blocker)
-> (Blocked a -> Blocker) -> Blocked a -> Set Blocker
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Blocked a -> Blocker
forall {t} {a}. Blocked' t a -> Blocker
blocker) f (Blocked a)
bs
blocker :: Blocked' t a -> Blocker
blocker NotBlocked{} = Blocker
alwaysUnblock
blocker (Blocked Blocker
b a
_) = Blocker
b
{-# INLINABLE blockAny #-}
blockAny :: (Functor f, Foldable f) => f (Blocked a) -> Blocked (f a)
blockAny :: forall (f :: * -> *) a.
(Functor f, Foldable f) =>
f (Blocked a) -> Blocked (f a)
blockAny f (Blocked a)
bs = Blocker -> f a -> Blocked' Term (f a)
forall a t. Blocker -> a -> Blocked' t a
blockedOn Blocker
block (f a -> Blocked' Term (f a)) -> f a -> Blocked' Term (f a)
forall a b. (a -> b) -> a -> b
$ (Blocked a -> a) -> f (Blocked a) -> f a
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Blocked a -> a
forall t a. Blocked' t a -> a
ignoreBlocking f (Blocked a)
bs
where block :: Blocker
block = case (Blocked a -> [Blocker]) -> f (Blocked a) -> [Blocker]
forall m a. Monoid m => (a -> m) -> f a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Blocked a -> [Blocker]
forall {t} {a}. Blocked' t a -> [Blocker]
blocker f (Blocked a)
bs of
[] -> Blocker
alwaysUnblock
[Blocker]
bs -> Set Blocker -> Blocker
unblockOnAny (Set Blocker -> Blocker) -> Set Blocker -> Blocker
forall a b. (a -> b) -> a -> b
$ [Blocker] -> Set Blocker
forall a. Ord a => [a] -> Set a
Set.fromList [Blocker]
bs
blocker :: Blocked' t a -> [Blocker]
blocker NotBlocked{} = []
blocker (Blocked Blocker
b a
_) = [Blocker
b]
{-# SPECIALIZE blockOnError :: Blocker -> TCM a -> TCM a #-}
blockOnError :: MonadError TCErr m => Blocker -> m a -> m a
blockOnError :: forall (m :: * -> *) a. MonadError TCErr m => Blocker -> m a -> m a
blockOnError Blocker
blocker m a
f
| Blocker
blocker Blocker -> Blocker -> Bool
forall a. Eq a => a -> a -> Bool
== Blocker
neverUnblock = m a
f
| Bool
otherwise = m a
f m a -> (TCErr -> m a) -> m a
forall a. m a -> (TCErr -> m a) -> m a
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
`catchError` \case
TypeError{} -> TCErr -> m a
forall a. TCErr -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (TCErr -> m a) -> TCErr -> m a
forall a b. (a -> b) -> a -> b
$ Blocker -> TCErr
PatternErr Blocker
blocker
PatternErr Blocker
blocker' -> TCErr -> m a
forall a. TCErr -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (TCErr -> m a) -> TCErr -> m a
forall a b. (a -> b) -> a -> b
$ Blocker -> TCErr
PatternErr (Blocker -> TCErr) -> Blocker -> TCErr
forall a b. (a -> b) -> a -> b
$ Blocker -> Blocker -> Blocker
unblockOnEither Blocker
blocker Blocker
blocker'
err :: TCErr
err@Exception{} -> TCErr -> m a
forall a. TCErr -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError TCErr
err
err :: TCErr
err@IOException{} -> TCErr -> m a
forall a. TCErr -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError TCErr
err
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)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> f a -> f (f 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 t => Instantiate (IPBoundary' t)
instance Instantiate () where
instantiate' :: () -> ReduceM ()
instantiate' () = () -> ReduceM ()
forall a. a -> ReduceM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
instance (Instantiate a, Instantiate b) => Instantiate (a,b) where
instantiate' :: (a, b) -> ReduceM (a, b)
instantiate' (a
x,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 a b. ReduceM (a -> b) -> ReduceM a -> ReduceM 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' (a
x,b
y,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 a b. ReduceM (a -> b) -> ReduceM a -> ReduceM 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 ReduceM (c -> (a, b, c)) -> ReduceM c -> ReduceM (a, b, c)
forall a b. ReduceM (a -> b) -> ReduceM a -> ReduceM b
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
ifPredicateDoesNotHoldFor ::
MetaId -> ReduceM a -> ReduceM a -> ReduceM a
ifPredicateDoesNotHoldFor :: forall a. MetaId -> ReduceM a -> ReduceM a -> ReduceM a
ifPredicateDoesNotHoldFor MetaId
m ReduceM a
doesNotHold ReduceM a
holds = do
pred <- ReduceEnv -> Maybe (MetaId -> ReduceM Bool)
redPred (ReduceEnv -> Maybe (MetaId -> ReduceM Bool))
-> ReduceM ReduceEnv -> ReduceM (Maybe (MetaId -> ReduceM Bool))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReduceM ReduceEnv
askR
case pred of
Maybe (MetaId -> ReduceM Bool)
Nothing -> ReduceM a
holds
Just MetaId -> ReduceM Bool
p -> ReduceM Bool -> ReduceM a -> ReduceM a -> ReduceM a
forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifM (MetaId -> ReduceM Bool
p MetaId
m) ReduceM a
holds ReduceM a
doesNotHold
instance Instantiate Term where
instantiate' :: Term -> ReduceM Term
instantiate' t :: Term
t@(MetaV MetaId
x Elims
es) = MetaId -> ReduceM Term -> ReduceM Term -> ReduceM Term
forall a. MetaId -> ReduceM a -> ReduceM a -> ReduceM a
ifPredicateDoesNotHoldFor MetaId
x (Term -> ReduceM Term
forall a. a -> ReduceM a
forall (m :: * -> *) a. Monad m => a -> m a
return Term
t) (ReduceM Term -> ReduceM Term) -> ReduceM Term -> ReduceM Term
forall a b. (a -> b) -> a -> b
$ do
blocking <- Lens' TCState Bool -> TCState -> Bool
forall o (m :: * -> *) i. MonadReader o m => Lens' o i -> m i
view (Bool -> f Bool) -> TCState -> f TCState
Lens' TCState Bool
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
m <- lookupMeta x
case m of
Just (Left RemoteMetaVariable
rmv) -> Instantiation -> ReduceM Term
cont (RemoteMetaVariable -> Instantiation
rmvInstantiation RemoteMetaVariable
rmv)
Just (Right MetaVariable
mv) -> case MetaVariable -> MetaInstantiation
mvInstantiation MetaVariable
mv of
InstV Instantiation
inst -> Instantiation -> ReduceM Term
cont Instantiation
inst
MetaInstantiation
_ | Just MetaId
m' <- MetaVariable -> Maybe MetaId
mvTwin MetaVariable
mv, Bool
blocking ->
Term -> ReduceM Term
forall t. Instantiate t => t -> ReduceM t
instantiate' (MetaId -> Elims -> Term
MetaV MetaId
m' Elims
es)
OpenMeta MetaKind
_ -> Term -> ReduceM Term
forall a. a -> ReduceM a
forall (m :: * -> *) a. Monad m => a -> m a
return Term
t
BlockedConst 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 a. a -> ReduceM a
forall (m :: * -> *) a. Monad m => a -> m a
return Term
t
PostponedTypeCheckingProblem Closure TypeCheckingProblem
_ -> Term -> ReduceM Term
forall a. a -> ReduceM a
forall (m :: * -> *) a. Monad m => a -> m a
return Term
t
Maybe (Either RemoteMetaVariable MetaVariable)
Nothing -> [Char] -> ReduceM Term
forall (m :: * -> *) a.
(HasCallStack, MonadDebug m) =>
[Char] -> m a
__IMPOSSIBLE_VERBOSE__
([Char]
"Meta-variable not found: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ MetaId -> [Char]
forall a. Pretty a => a -> [Char]
prettyShow MetaId
x)
where
cont :: Instantiation -> ReduceM Term
cont Instantiation
i = Term -> ReduceM Term
forall t. Instantiate t => t -> ReduceM t
instantiate' Term
inst
where
(Elims
es1, Elims
es2) = Int -> Elims -> (Elims, Elims)
forall a. Int -> [a] -> ([a], [a])
splitAt ([Arg [Char]] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Instantiation -> [Arg [Char]]
instTel Instantiation
i)) 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 a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Term]
vs1) Substitution' Term
forall a. Substitution' a
idS
inst :: Term
inst =
Substitution' (SubstArg Term) -> Term -> Term
forall a. Subst a => Substitution' (SubstArg a) -> a -> a
applySubst Substitution' Term
Substitution' (SubstArg Term)
rho
((Arg [Char] -> Term -> Term) -> Term -> [Arg [Char]] -> Term
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Arg [Char] -> Term -> Term
mkLam (Instantiation -> Term
instBody Instantiation
i) ([Arg [Char]] -> Term) -> [Arg [Char]] -> Term
forall a b. (a -> b) -> a -> b
$ Int -> [Arg [Char]] -> [Arg [Char]]
forall a. Int -> [a] -> [a]
drop (Elims -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Elims
es1) (Instantiation -> [Arg [Char]]
instTel Instantiation
i))
Term -> Elims -> Term
forall t. Apply t => t -> Elims -> t
`applyE` Elims
es2
instantiate' (Level 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 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' Term
t = Term -> ReduceM Term
forall a. a -> ReduceM a
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 Sort
s 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 a b. ReduceM (a -> b) -> ReduceM a -> ReduceM b
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 Integer
m [PlusLevel]
as) = Integer -> [PlusLevel] -> Level
levelMax Integer
m ([PlusLevel] -> Level) -> ReduceM [PlusLevel] -> ReduceM Level
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [PlusLevel] -> ReduceM [PlusLevel]
forall t. Instantiate t => t -> ReduceM t
instantiate' [PlusLevel]
as
instance Instantiate t => Instantiate (PlusLevel' t)
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 a. a -> ReduceM a
forall (m :: * -> *) a. Monad m => a -> m a
return Blocked a
v
instantiate' v :: Blocked a
v@(Blocked Blocker
b a
u) = Blocker -> ReduceM Blocker
forall t. Instantiate t => t -> ReduceM t
instantiate' Blocker
b ReduceM Blocker
-> (Blocker -> ReduceM (Blocked a)) -> ReduceM (Blocked a)
forall a b. ReduceM a -> (a -> ReduceM b) -> ReduceM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ case
Blocker
b | Blocker
b Blocker -> Blocker -> Bool
forall a. Eq a => a -> a -> Bool
== Blocker
alwaysUnblock -> a -> Blocked a
forall a t. a -> Blocked' t 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
| Bool
otherwise -> Blocked a -> ReduceM (Blocked a)
forall a. a -> ReduceM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocked a -> ReduceM (Blocked a))
-> Blocked a -> ReduceM (Blocked a)
forall a b. (a -> b) -> a -> b
$ Blocker -> a -> Blocked a
forall t a. Blocker -> a -> Blocked' t a
Blocked Blocker
b a
u
instance Instantiate Blocker where
instantiate' :: Blocker -> ReduceM Blocker
instantiate' (UnblockOnAll Set Blocker
bs) = Set Blocker -> Blocker
unblockOnAll (Set Blocker -> Blocker)
-> ([Blocker] -> Set Blocker) -> [Blocker] -> Blocker
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Blocker] -> Set Blocker
forall a. Ord a => [a] -> Set a
Set.fromList ([Blocker] -> Blocker) -> ReduceM [Blocker] -> ReduceM Blocker
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Blocker -> ReduceM Blocker) -> [Blocker] -> ReduceM [Blocker]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Blocker -> ReduceM Blocker
forall t. Instantiate t => t -> ReduceM t
instantiate' (Set Blocker -> [Blocker]
forall a. Set a -> [a]
Set.toList Set Blocker
bs)
instantiate' (UnblockOnAny Set Blocker
bs) = Set Blocker -> Blocker
unblockOnAny (Set Blocker -> Blocker)
-> ([Blocker] -> Set Blocker) -> [Blocker] -> Blocker
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Blocker] -> Set Blocker
forall a. Ord a => [a] -> Set a
Set.fromList ([Blocker] -> Blocker) -> ReduceM [Blocker] -> ReduceM Blocker
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Blocker -> ReduceM Blocker) -> [Blocker] -> ReduceM [Blocker]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Blocker -> ReduceM Blocker
forall t. Instantiate t => t -> ReduceM t
instantiate' (Set Blocker -> [Blocker]
forall a. Set a -> [a]
Set.toList Set Blocker
bs)
instantiate' b :: Blocker
b@(UnblockOnMeta MetaId
x) =
ReduceM Bool
-> ReduceM Blocker -> ReduceM Blocker -> ReduceM Blocker
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
forall (m :: * -> *).
(MonadFail m, ReadTCState m) =>
MetaId -> m Bool
isInstantiatedMeta MetaId
x) (Blocker -> ReduceM Blocker
forall a. a -> ReduceM a
forall (m :: * -> *) a. Monad m => a -> m a
return Blocker
alwaysUnblock) (Blocker -> ReduceM Blocker
forall a. a -> ReduceM a
forall (m :: * -> *) a. Monad m => a -> m a
return Blocker
b)
instantiate' (UnblockOnProblem ProblemId
pi) =
ReduceM Bool
-> ReduceM Blocker -> ReduceM Blocker -> ReduceM Blocker
forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifM (ProblemId -> ReduceM Bool
forall (m :: * -> *).
(MonadTCEnv m, ReadTCState m) =>
ProblemId -> m Bool
isProblemSolved ProblemId
pi) (Blocker -> ReduceM Blocker
forall a. a -> ReduceM a
forall (m :: * -> *) a. Monad m => a -> m a
return Blocker
alwaysUnblock) (Blocker -> ReduceM Blocker
forall a. a -> ReduceM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocker -> ReduceM Blocker) -> Blocker -> ReduceM Blocker
forall a b. (a -> b) -> a -> b
$ ProblemId -> Blocker
UnblockOnProblem ProblemId
pi)
instantiate' b :: Blocker
b@UnblockOnDef{} = Blocker -> ReduceM Blocker
forall a. a -> ReduceM a
forall (m :: * -> *) a. Monad m => a -> m a
return Blocker
b
instance Instantiate Sort where
instantiate' :: Sort -> ReduceM Sort
instantiate' = \case
MetaS MetaId
x 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 a b. ReduceM a -> (a -> ReduceM b) -> ReduceM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Sort Sort
s' -> Sort -> ReduceM Sort
forall a. a -> ReduceM a
forall (m :: * -> *) a. Monad m => a -> m a
return Sort
s'
MetaV MetaId
x' Elims
es' -> Sort -> ReduceM Sort
forall a. a -> ReduceM a
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 QName
d Elims
es' -> Sort -> ReduceM Sort
forall a. a -> ReduceM a
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'
Term
_ -> ReduceM Sort
forall a. HasCallStack => a
__IMPOSSIBLE__
Sort
s -> Sort -> ReduceM Sort
forall a. a -> ReduceM a
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 ArgInfo
i Maybe NamedName
n Bool
b Maybe t
tac e
x) = ArgInfo -> Maybe NamedName -> Bool -> Maybe t -> e -> Dom' t e
forall t e.
ArgInfo -> Maybe NamedName -> Bool -> Maybe t -> e -> Dom' t e
Dom ArgInfo
i Maybe NamedName
n Bool
b (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 a b. ReduceM (a -> b) -> ReduceM a -> ReduceM b
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' Closure a
cl = do
x <- Closure a -> (a -> ReduceM a) -> ReduceM a
forall c a b. LensClosure c a => c -> (a -> ReduceM b) -> ReduceM b
enterClosure Closure a
cl a -> ReduceM a
forall t. Instantiate t => t -> ReduceM t
instantiate'
return $ cl { clValue = x }
instance Instantiate Constraint where
instantiate' :: Constraint -> ReduceM Constraint
instantiate' (ValueCmp Comparison
cmp CompareAs
t Term
u Term
v) = do
(t,u,v) <- (CompareAs, Term, Term) -> ReduceM (CompareAs, Term, Term)
forall t. Instantiate t => t -> ReduceM t
instantiate' (CompareAs
t,Term
u,Term
v)
return $ ValueCmp cmp t u v
instantiate' (ValueCmpOnFace Comparison
cmp Term
p Type
t Term
u Term
v) = do
((p,t),u,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)
return $ ValueCmpOnFace cmp p t u v
instantiate' (ElimCmp [Polarity]
cmp [IsForced]
fs Type
t Term
v Elims
as 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 a b. ReduceM (a -> b) -> ReduceM a -> ReduceM b
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 a b. ReduceM (a -> b) -> ReduceM a -> ReduceM b
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 a b. ReduceM (a -> b) -> ReduceM a -> ReduceM b
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 Comparison
cmp Level
u 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' (SortCmp Comparison
cmp Sort
a 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' (UnBlock MetaId
m) = Constraint -> ReduceM Constraint
forall a. a -> ReduceM a
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 MetaId
m Maybe [Candidate]
cs) = MetaId -> Maybe [Candidate] -> Constraint
FindInstance MetaId
m (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)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Maybe a -> m (Maybe b)
mapM [Candidate] -> ReduceM [Candidate]
forall t. Instantiate t => t -> ReduceM t
instantiate' Maybe [Candidate]
cs
instantiate' (ResolveInstanceHead QName
q) = Constraint -> ReduceM Constraint
forall a. a -> ReduceM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Constraint -> ReduceM Constraint)
-> Constraint -> ReduceM Constraint
forall a b. (a -> b) -> a -> b
$ QName -> Constraint
ResolveInstanceHead QName
q
instantiate' (IsEmpty Range
r 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 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 a. a -> ReduceM a
forall (m :: * -> *) a. Monad m => a -> m a
return Constraint
c
instantiate' (HasBiggerSort 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 Dom Type
a 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' (CheckLockedVars Term
a Type
b Arg Term
c Type
d) =
Term -> Type -> Arg Term -> Type -> Constraint
CheckLockedVars (Term -> Type -> Arg Term -> Type -> Constraint)
-> ReduceM Term -> ReduceM (Type -> Arg 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
a ReduceM (Type -> Arg Term -> Type -> Constraint)
-> ReduceM Type -> ReduceM (Arg Term -> Type -> Constraint)
forall a b. ReduceM (a -> b) -> ReduceM a -> ReduceM b
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
b ReduceM (Arg Term -> Type -> Constraint)
-> ReduceM (Arg Term) -> ReduceM (Type -> Constraint)
forall a b. ReduceM (a -> b) -> ReduceM a -> ReduceM b
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
c ReduceM (Type -> Constraint) -> ReduceM Type -> ReduceM Constraint
forall a b. ReduceM (a -> b) -> ReduceM a -> ReduceM b
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
d
instantiate' (UnquoteTactic Term
t Term
h Type
g) = Term -> Term -> Type -> Constraint
UnquoteTactic (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 a b. ReduceM (a -> b) -> ReduceM a -> ReduceM b
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 a b. ReduceM (a -> b) -> ReduceM a -> ReduceM b
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' (CheckDataSort QName
q Sort
s) = QName -> Sort -> Constraint
CheckDataSort QName
q (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
s
instantiate' c :: Constraint
c@CheckMetaInst{} = Constraint -> ReduceM Constraint
forall a. a -> ReduceM a
forall (m :: * -> *) a. Monad m => a -> m a
return Constraint
c
instantiate' (CheckType Type
t) = Type -> Constraint
CheckType (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' (UsableAtModality WhyCheckModality
cc Maybe Sort
ms Modality
mod Term
t) = (Maybe Sort -> Modality -> Term -> Constraint)
-> Modality -> Maybe Sort -> Term -> Constraint
forall a b c. (a -> b -> c) -> b -> a -> c
flip (WhyCheckModality -> Maybe Sort -> Modality -> Term -> Constraint
UsableAtModality WhyCheckModality
cc) Modality
mod (Maybe Sort -> Term -> Constraint)
-> ReduceM (Maybe Sort) -> ReduceM (Term -> Constraint)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Sort -> ReduceM (Maybe Sort)
forall t. Instantiate t => t -> ReduceM t
instantiate' Maybe Sort
ms ReduceM (Term -> Constraint) -> ReduceM Term -> ReduceM Constraint
forall a b. ReduceM (a -> b) -> ReduceM a -> ReduceM b
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
t
instance Instantiate CompareAs where
instantiate' :: CompareAs -> ReduceM CompareAs
instantiate' (AsTermsOf 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' CompareAs
AsSizes = CompareAs -> ReduceM CompareAs
forall a. a -> ReduceM a
forall (m :: * -> *) a. Monad m => a -> m a
return CompareAs
AsSizes
instantiate' CompareAs
AsTypes = CompareAs -> ReduceM CompareAs
forall a. a -> ReduceM a
forall (m :: * -> *) a. Monad m => a -> m a
return CompareAs
AsTypes
instance Instantiate Candidate where
instantiate' :: Candidate -> ReduceM Candidate
instantiate' (Candidate CandidateKind
q Term
u Type
t OverlapMode
ov) = CandidateKind -> Term -> Type -> OverlapMode -> Candidate
Candidate CandidateKind
q (Term -> Type -> OverlapMode -> Candidate)
-> ReduceM Term -> ReduceM (Type -> OverlapMode -> 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 -> OverlapMode -> Candidate)
-> ReduceM Type -> ReduceM (OverlapMode -> Candidate)
forall a b. ReduceM (a -> b) -> ReduceM a -> ReduceM b
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 (OverlapMode -> Candidate)
-> ReduceM OverlapMode -> ReduceM Candidate
forall a b. ReduceM (a -> b) -> ReduceM a -> ReduceM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> OverlapMode -> ReduceM OverlapMode
forall a. a -> ReduceM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure OverlapMode
ov
instance Instantiate EqualityView where
instantiate' :: EqualityView -> ReduceM EqualityView
instantiate' (OtherType 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' (IdiomType Type
t) = Type -> EqualityView
IdiomType
(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 Sort
s QName
eq [Arg Term]
l Arg Term
t Arg Term
a 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 a b. ReduceM (a -> b) -> ReduceM a -> ReduceM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> QName -> ReduceM QName
forall a. a -> ReduceM a
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 a b. ReduceM (a -> b) -> ReduceM a -> ReduceM b
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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [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 a b. ReduceM (a -> b) -> ReduceM a -> ReduceM b
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 a b. ReduceM (a -> b) -> ReduceM a -> ReduceM b
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 a b. ReduceM (a -> b) -> ReduceM a -> ReduceM b
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 :: a -> Maybe MetaId
instance IsMeta Term where
isMeta :: Term -> Maybe MetaId
isMeta (MetaV MetaId
m Elims
_) = MetaId -> Maybe MetaId
forall a. a -> Maybe a
Just MetaId
m
isMeta Term
_ = Maybe MetaId
forall a. Maybe a
Nothing
instance IsMeta a => IsMeta (Sort' a) where
isMeta :: Sort' a -> Maybe MetaId
isMeta (MetaS MetaId
m [Elim' a]
_) = MetaId -> Maybe MetaId
forall a. a -> Maybe a
Just MetaId
m
isMeta Sort' a
_ = Maybe MetaId
forall a. Maybe a
Nothing
instance IsMeta a => IsMeta (Type'' t a) where
isMeta :: Type'' t a -> Maybe MetaId
isMeta = a -> Maybe MetaId
forall a. IsMeta a => a -> Maybe MetaId
isMeta (a -> Maybe MetaId)
-> (Type'' t a -> a) -> Type'' t a -> Maybe MetaId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type'' t a -> a
forall t a. Type'' t a -> a
unEl
instance IsMeta a => IsMeta (Elim' a) where
isMeta :: Elim' a -> Maybe MetaId
isMeta Proj{} = Maybe MetaId
forall a. Maybe a
Nothing
isMeta IApply{} = Maybe MetaId
forall a. Maybe a
Nothing
isMeta (Apply Arg a
a) = Arg a -> Maybe MetaId
forall a. IsMeta a => a -> Maybe MetaId
isMeta Arg a
a
instance IsMeta a => IsMeta (Arg a) where
isMeta :: Arg a -> Maybe MetaId
isMeta = a -> Maybe MetaId
forall a. IsMeta a => a -> Maybe MetaId
isMeta (a -> Maybe MetaId) -> (Arg a -> a) -> Arg a -> Maybe MetaId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Arg a -> a
forall e. Arg e -> e
unArg
instance IsMeta a => IsMeta (Level' a) where
isMeta :: Level' a -> Maybe MetaId
isMeta (Max Integer
0 [PlusLevel' a
l]) = PlusLevel' a -> Maybe MetaId
forall a. IsMeta a => a -> Maybe MetaId
isMeta PlusLevel' a
l
isMeta Level' a
_ = Maybe MetaId
forall a. Maybe a
Nothing
instance IsMeta a => IsMeta (PlusLevel' a) where
isMeta :: PlusLevel' a -> Maybe MetaId
isMeta (Plus Integer
0 a
l) = a -> Maybe MetaId
forall a. IsMeta a => a -> Maybe MetaId
isMeta a
l
isMeta PlusLevel' a
_ = Maybe MetaId
forall a. Maybe a
Nothing
instance IsMeta CompareAs where
isMeta :: CompareAs -> Maybe MetaId
isMeta (AsTermsOf Type
a) = Type -> Maybe MetaId
forall a. IsMeta a => a -> Maybe MetaId
isMeta Type
a
isMeta CompareAs
AsSizes = Maybe MetaId
forall a. Maybe a
Nothing
isMeta CompareAs
AsTypes = Maybe MetaId
forall a. Maybe a
Nothing
ifBlocked
:: (Reduce t, IsMeta t, MonadReduce m)
=> t -> (Blocker -> t -> m a) -> (NotBlocked -> t -> m a) -> m a
ifBlocked :: forall t (m :: * -> *) a.
(Reduce t, IsMeta t, MonadReduce m) =>
t -> (Blocker -> t -> m a) -> (NotBlocked -> t -> m a) -> m a
ifBlocked t
t Blocker -> t -> m a
blocked NotBlocked -> t -> m a
unblocked = do
t <- t -> m (Blocked t)
forall a (m :: * -> *).
(Reduce a, MonadReduce m) =>
a -> m (Blocked a)
reduceB t
t
case t of
Blocked Blocker
m t
t -> Blocker -> t -> m a
blocked Blocker
m t
t
NotBlocked NotBlocked
nb t
t -> case t -> Maybe MetaId
forall a. IsMeta a => a -> Maybe MetaId
isMeta t
t of
Just MetaId
m -> Blocker -> t -> m a
blocked (MetaId -> Blocker
unblockOnMeta MetaId
m) t
t
Maybe MetaId
Nothing -> NotBlocked -> t -> m a
unblocked NotBlocked
nb t
t
abortIfBlocked :: (MonadReduce m, MonadBlock m, IsMeta t, Reduce t) => t -> m t
abortIfBlocked :: forall (m :: * -> *) t.
(MonadReduce m, MonadBlock m, IsMeta t, Reduce t) =>
t -> m t
abortIfBlocked t
t = t -> (Blocker -> t -> m t) -> (NotBlocked -> t -> m t) -> m t
forall t (m :: * -> *) a.
(Reduce t, IsMeta t, MonadReduce m) =>
t -> (Blocker -> t -> m a) -> (NotBlocked -> t -> m a) -> m a
ifBlocked t
t (m t -> t -> m t
forall a b. a -> b -> a
const (m t -> t -> m t) -> (Blocker -> m t) -> Blocker -> t -> m t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Blocker -> m t
forall a. Blocker -> m a
forall (m :: * -> *) a. MonadBlock m => Blocker -> m a
patternViolation) ((t -> m t) -> NotBlocked -> t -> m t
forall a b. a -> b -> a
const t -> m t
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return)
isBlocked
:: (Reduce t, IsMeta t, MonadReduce m)
=> t -> m (Maybe Blocker)
isBlocked :: forall t (m :: * -> *).
(Reduce t, IsMeta t, MonadReduce m) =>
t -> m (Maybe Blocker)
isBlocked t
t = t
-> (Blocker -> t -> m (Maybe Blocker))
-> (NotBlocked -> t -> m (Maybe Blocker))
-> m (Maybe Blocker)
forall t (m :: * -> *) a.
(Reduce t, IsMeta t, MonadReduce m) =>
t -> (Blocker -> t -> m a) -> (NotBlocked -> t -> m a) -> m a
ifBlocked t
t (\Blocker
m t
_ -> Maybe Blocker -> m (Maybe Blocker)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Blocker -> m (Maybe Blocker))
-> Maybe Blocker -> m (Maybe Blocker)
forall a b. (a -> b) -> a -> b
$ Blocker -> Maybe Blocker
forall a. a -> Maybe a
Just Blocker
m) (\NotBlocked
_ t
_ -> Maybe Blocker -> m (Maybe Blocker)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Blocker
forall a. Maybe a
Nothing)
fromBlocked :: MonadBlock m => Blocked a -> m a
fromBlocked :: forall (m :: * -> *) a. MonadBlock m => Blocked a -> m a
fromBlocked (Blocked Blocker
b a
_) = Blocker -> m a
forall a. Blocker -> m a
forall (m :: * -> *) a. MonadBlock m => Blocker -> m a
patternViolation Blocker
b
fromBlocked (NotBlocked NotBlocked
_ a
x) = a -> m a
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x
class Reduce t where
reduce' :: t -> ReduceM t
reduceB' :: t -> ReduceM (Blocked t)
reduce' t
t = Blocked t -> t
forall t a. Blocked' t a -> a
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 -> Blocked t
forall a t. a -> Blocked' t 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 Sort
s 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 Sort
s 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 Term -> Blocked Type
forall a b. (a -> b) -> Blocked' Term a -> Blocked' Term b
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 Term -> Blocked Type)
-> ReduceM (Blocked' Term Term) -> ReduceM (Blocked Type)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term -> ReduceM (Blocked' Term Term)
forall t. Reduce t => t -> ReduceM (Blocked t)
reduceB' Term
t
instance Reduce Sort where
reduceB' :: Sort -> ReduceM (Blocked Sort)
reduceB' Sort
s = do
s <- Sort -> ReduceM Sort
forall t. Instantiate t => t -> ReduceM t
instantiate' Sort
s
let done | MetaS MetaId
x Elims
_ <- Sort
s = Blocked Sort -> ReduceM (Blocked Sort)
forall a. a -> ReduceM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocked Sort -> ReduceM (Blocked Sort))
-> Blocked Sort -> ReduceM (Blocked Sort)
forall a b. (a -> b) -> a -> b
$ MetaId -> Sort -> Blocked Sort
forall a t. MetaId -> a -> Blocked' t a
blocked MetaId
x Sort
s
| Bool
otherwise = Blocked Sort -> ReduceM (Blocked Sort)
forall a. a -> ReduceM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocked Sort -> ReduceM (Blocked Sort))
-> Blocked Sort -> ReduceM (Blocked Sort)
forall a b. (a -> b) -> a -> b
$ Sort -> Blocked Sort
forall a t. a -> Blocked' t a
notBlocked Sort
s
case s of
PiSort Dom' Term Term
a Sort
s1 Abs Sort
s2 -> (Sort, Abs Sort) -> ReduceM (Blocked (Sort, Abs Sort))
forall t. Reduce t => t -> ReduceM (Blocked t)
reduceB' (Sort
s1 , Abs Sort
s2) ReduceM (Blocked (Sort, Abs Sort))
-> (Blocked (Sort, Abs Sort) -> ReduceM (Blocked Sort))
-> ReduceM (Blocked Sort)
forall a b. ReduceM a -> (a -> ReduceM b) -> ReduceM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Blocked Blocker
b (Sort
s1',Abs Sort
s2') -> Blocked Sort -> ReduceM (Blocked Sort)
forall a. a -> ReduceM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocked Sort -> ReduceM (Blocked Sort))
-> Blocked Sort -> ReduceM (Blocked Sort)
forall a b. (a -> b) -> a -> b
$ Blocker -> Sort -> Blocked Sort
forall t a. Blocker -> a -> Blocked' t a
Blocked Blocker
b (Sort -> Blocked Sort) -> Sort -> Blocked Sort
forall a b. (a -> b) -> a -> b
$ Dom' Term Term -> Sort -> Abs Sort -> Sort
forall t. Dom' t t -> Sort' t -> Abs (Sort' t) -> Sort' t
PiSort Dom' Term Term
a Sort
s1' Abs Sort
s2'
NotBlocked NotBlocked
_ (Sort
s1',Abs Sort
s2') -> do
s2' <- Abs Sort -> ReduceM (Abs Sort)
forall a (m :: * -> *).
(InstantiateFull a, MonadReduce m) =>
a -> m a
instantiateFull Abs Sort
s2'
case piSort' a s1' s2' of
Left Blocker
b -> Blocked Sort -> ReduceM (Blocked Sort)
forall a. a -> ReduceM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocked Sort -> ReduceM (Blocked Sort))
-> Blocked Sort -> ReduceM (Blocked Sort)
forall a b. (a -> b) -> a -> b
$ Blocker -> Sort -> Blocked Sort
forall t a. Blocker -> a -> Blocked' t a
Blocked Blocker
b (Sort -> Blocked Sort) -> Sort -> Blocked Sort
forall a b. (a -> b) -> a -> b
$ Dom' Term Term -> Sort -> Abs Sort -> Sort
forall t. Dom' t t -> Sort' t -> Abs (Sort' t) -> Sort' t
PiSort Dom' Term Term
a Sort
s1' Abs Sort
s2'
Right Sort
s -> Sort -> ReduceM (Blocked Sort)
forall t. Reduce t => t -> ReduceM (Blocked t)
reduceB' Sort
s
FunSort Sort
s1 Sort
s2 -> (Sort, Sort) -> ReduceM (Blocked (Sort, Sort))
forall t. Reduce t => t -> ReduceM (Blocked t)
reduceB' (Sort
s1 , Sort
s2) ReduceM (Blocked (Sort, Sort))
-> (Blocked (Sort, Sort) -> ReduceM (Blocked Sort))
-> ReduceM (Blocked Sort)
forall a b. ReduceM a -> (a -> ReduceM b) -> ReduceM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Blocked Blocker
b (Sort
s1',Sort
s2') -> Blocked Sort -> ReduceM (Blocked Sort)
forall a. a -> ReduceM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocked Sort -> ReduceM (Blocked Sort))
-> Blocked Sort -> ReduceM (Blocked Sort)
forall a b. (a -> b) -> a -> b
$ Blocker -> Sort -> Blocked Sort
forall t a. Blocker -> a -> Blocked' t a
Blocked Blocker
b (Sort -> Blocked Sort) -> Sort -> Blocked Sort
forall a b. (a -> b) -> a -> b
$ Sort -> Sort -> Sort
forall t. Sort' t -> Sort' t -> Sort' t
FunSort Sort
s1' Sort
s2'
NotBlocked NotBlocked
_ (Sort
s1',Sort
s2') -> do
case Sort -> Sort -> Either Blocker Sort
funSort' Sort
s1' Sort
s2' of
Left Blocker
b -> Blocked Sort -> ReduceM (Blocked Sort)
forall a. a -> ReduceM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocked Sort -> ReduceM (Blocked Sort))
-> Blocked Sort -> ReduceM (Blocked Sort)
forall a b. (a -> b) -> a -> b
$ Blocker -> Sort -> Blocked Sort
forall t a. Blocker -> a -> Blocked' t a
Blocked Blocker
b (Sort -> Blocked Sort) -> Sort -> Blocked Sort
forall a b. (a -> b) -> a -> b
$ Sort -> Sort -> Sort
forall t. Sort' t -> Sort' t -> Sort' t
FunSort Sort
s1' Sort
s2'
Right Sort
s -> Sort -> ReduceM (Blocked Sort)
forall t. Reduce t => t -> ReduceM (Blocked t)
reduceB' Sort
s
UnivSort Sort
s1 -> Sort -> ReduceM (Blocked Sort)
forall t. Reduce t => t -> ReduceM (Blocked t)
reduceB' Sort
s1 ReduceM (Blocked Sort)
-> (Blocked Sort -> ReduceM (Blocked Sort))
-> ReduceM (Blocked Sort)
forall a b. ReduceM a -> (a -> ReduceM b) -> ReduceM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Blocked Blocker
b Sort
s1' -> Blocked Sort -> ReduceM (Blocked Sort)
forall a. a -> ReduceM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocked Sort -> ReduceM (Blocked Sort))
-> Blocked Sort -> ReduceM (Blocked Sort)
forall a b. (a -> b) -> a -> b
$ Blocker -> Sort -> Blocked Sort
forall t a. Blocker -> a -> Blocked' t a
Blocked Blocker
b (Sort -> Blocked Sort) -> Sort -> Blocked Sort
forall a b. (a -> b) -> a -> b
$ Sort -> Sort
forall t. Sort' t -> Sort' t
UnivSort Sort
s1'
NotBlocked NotBlocked
_ Sort
s1' -> case Sort -> Either Blocker Sort
univSort' Sort
s1' of
Left Blocker
b -> Blocked Sort -> ReduceM (Blocked Sort)
forall a. a -> ReduceM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocked Sort -> ReduceM (Blocked Sort))
-> Blocked Sort -> ReduceM (Blocked Sort)
forall a b. (a -> b) -> a -> b
$ Blocker -> Sort -> Blocked Sort
forall t a. Blocker -> a -> Blocked' t a
Blocked Blocker
b (Sort -> Blocked Sort) -> Sort -> Blocked Sort
forall a b. (a -> b) -> a -> b
$ Sort -> Sort
forall t. Sort' t -> Sort' t
UnivSort Sort
s1'
Right Sort
s -> Sort -> ReduceM (Blocked Sort)
forall t. Reduce t => t -> ReduceM (Blocked t)
reduceB' Sort
s
Univ Univ
u Level
l -> Sort -> Blocked Sort
forall a t. a -> Blocked' t a
notBlocked (Sort -> Blocked Sort) -> (Level -> Sort) -> Level -> Blocked Sort
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Univ -> Level -> Sort
forall t. Univ -> Level' t -> Sort' t
Univ Univ
u (Level -> Blocked Sort) -> ReduceM Level -> ReduceM (Blocked Sort)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Level -> ReduceM Level
forall a (m :: * -> *). (Reduce a, MonadReduce m) => a -> m a
reduce Level
l
Inf Univ
_ Integer
_ -> ReduceM (Blocked Sort)
done
Sort
SizeUniv -> ReduceM (Blocked Sort)
done
Sort
LockUniv -> ReduceM (Blocked Sort)
done
Sort
LevelUniv -> do
levelUniverseEnabled <- ReduceM Bool
forall (m :: * -> *). HasOptions m => m Bool
isLevelUniverseEnabled
if levelUniverseEnabled
then done
else return $ notBlocked (mkType 0)
Sort
IntervalUniv -> ReduceM (Blocked Sort)
done
MetaS MetaId
x Elims
es -> ReduceM (Blocked Sort)
done
DefS QName
d Elims
es -> ReduceM (Blocked Sort)
done
DummyS{} -> ReduceM (Blocked Sort)
done
instance Reduce Elim where
reduce' :: Elim -> ReduceM Elim
reduce' (Apply 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 ProjOrigin
o QName
f)= Elim -> ReduceM Elim
forall a. a -> ReduceM a
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 Term
x Term
y 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 a b. ReduceM (a -> b) -> ReduceM a -> ReduceM b
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 a b. ReduceM (a -> b) -> ReduceM a -> ReduceM b
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 Integer
m [PlusLevel]
as) = Integer -> [PlusLevel] -> Level
levelMax Integer
m ([PlusLevel] -> Level) -> ReduceM [PlusLevel] -> ReduceM Level
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PlusLevel -> ReduceM PlusLevel)
-> [PlusLevel] -> ReduceM [PlusLevel]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM PlusLevel -> ReduceM PlusLevel
forall t. Reduce t => t -> ReduceM t
reduce' [PlusLevel]
as
reduceB' :: Level -> ReduceM (Blocked Level)
reduceB' (Max Integer
m [PlusLevel]
as) = ([PlusLevel] -> Level)
-> Blocked' Term [PlusLevel] -> Blocked Level
forall a b. (a -> b) -> Blocked' Term a -> Blocked' Term b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Integer -> [PlusLevel] -> Level
levelMax Integer
m) (Blocked' Term [PlusLevel] -> Blocked Level)
-> ([Blocked PlusLevel] -> Blocked' Term [PlusLevel])
-> [Blocked PlusLevel]
-> Blocked Level
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Blocked PlusLevel] -> Blocked' Term [PlusLevel]
forall (f :: * -> *) a.
(Functor f, Foldable f) =>
f (Blocked a) -> Blocked (f a)
blockAny ([Blocked PlusLevel] -> Blocked Level)
-> ReduceM [Blocked PlusLevel] -> ReduceM (Blocked Level)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PlusLevel -> ReduceM (Blocked PlusLevel))
-> [PlusLevel] -> ReduceM [Blocked PlusLevel]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse PlusLevel -> ReduceM (Blocked PlusLevel)
forall t. Reduce t => t -> ReduceM (Blocked t)
reduceB' [PlusLevel]
as
instance Reduce PlusLevel where
reduceB' :: PlusLevel -> ReduceM (Blocked PlusLevel)
reduceB' (Plus Integer
n Term
l) = (Term -> PlusLevel) -> Blocked' Term Term -> Blocked PlusLevel
forall a b. (a -> b) -> Blocked' Term a -> Blocked' Term b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Integer -> Term -> PlusLevel
forall t. Integer -> t -> PlusLevel' t
Plus Integer
n) (Blocked' Term Term -> Blocked PlusLevel)
-> ReduceM (Blocked' Term Term) -> ReduceM (Blocked PlusLevel)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term -> ReduceM (Blocked' Term Term)
forall t. Reduce t => t -> ReduceM (Blocked t)
reduceB' Term
l
instance (Subst a, Reduce a) => Reduce (Abs a) where
reduceB' :: Abs a -> ReduceM (Blocked (Abs a))
reduceB' b :: Abs a
b@(Abs [Char]
x a
_) = (a -> Abs a) -> Blocked' Term a -> Blocked (Abs a)
forall a b. (a -> b) -> Blocked' Term a -> Blocked' Term b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Char] -> a -> Abs a
forall a. [Char] -> a -> Abs a
Abs [Char]
x) (Blocked' Term a -> Blocked (Abs a))
-> ReduceM (Blocked' Term a) -> ReduceM (Blocked (Abs a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Abs a
-> (a -> ReduceM (Blocked' Term a)) -> ReduceM (Blocked' Term a)
forall a (m :: * -> *) b.
(Subst a, MonadAddContext m) =>
Abs a -> (a -> m b) -> m b
underAbstraction_ Abs a
b a -> ReduceM (Blocked' Term a)
forall t. Reduce t => t -> ReduceM (Blocked t)
reduceB'
reduceB' (NoAbs [Char]
x a
v) = (a -> Abs a) -> Blocked' Term a -> Blocked (Abs a)
forall a b. (a -> b) -> Blocked' Term a -> Blocked' Term b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Char] -> a -> Abs a
forall a. [Char] -> a -> Abs a
NoAbs [Char]
x) (Blocked' Term a -> Blocked (Abs a))
-> ReduceM (Blocked' Term a) -> ReduceM (Blocked (Abs a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> ReduceM (Blocked' Term a)
forall t. Reduce t => t -> ReduceM (Blocked t)
reduceB' 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)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse t -> ReduceM t
forall t. Reduce t => t -> ReduceM t
reduce'
instance Reduce t => Reduce (Maybe t) where
reduce' :: Maybe t -> ReduceM (Maybe t)
reduce' = (t -> ReduceM t) -> Maybe t -> ReduceM (Maybe t)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe 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' Arg t
a = case Arg t -> Relevance
forall a. LensRelevance a => a -> Relevance
getRelevance Arg t
a of
Relevance
Irrelevant -> Arg t -> ReduceM (Arg t)
forall a. a -> ReduceM a
forall (m :: * -> *) a. Monad m => a -> m a
return Arg t
a
Relevance
_ -> (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)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Arg a -> f (Arg b)
traverse t -> ReduceM t
forall t. Reduce t => t -> ReduceM t
reduce' Arg t
a
reduceB' :: Arg t -> ReduceM (Blocked (Arg t))
reduceB' Arg t
t = (Blocked' Term t -> Blocked' Term t)
-> Arg (Blocked' Term t) -> Blocked (Arg t)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Arg a -> f (Arg b)
traverse Blocked' Term t -> Blocked' Term t
forall a. a -> a
id (Arg (Blocked' Term t) -> Blocked (Arg t))
-> ReduceM (Arg (Blocked' Term t)) -> ReduceM (Blocked (Arg t))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (t -> ReduceM (Blocked' Term t))
-> Arg t -> ReduceM (Arg (Blocked' Term t))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Arg a -> f (Arg b)
traverse t -> ReduceM (Blocked' Term 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)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Dom' Term a -> f (Dom' Term b)
traverse t -> ReduceM t
forall t. Reduce t => t -> ReduceM t
reduce'
reduceB' :: Dom t -> ReduceM (Blocked (Dom t))
reduceB' Dom t
t = (Blocked' Term t -> Blocked' Term t)
-> Dom' Term (Blocked' Term t) -> Blocked (Dom t)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Dom' Term a -> f (Dom' Term b)
traverse Blocked' Term t -> Blocked' Term t
forall a. a -> a
id (Dom' Term (Blocked' Term t) -> Blocked (Dom t))
-> ReduceM (Dom' Term (Blocked' Term t))
-> ReduceM (Blocked (Dom t))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (t -> ReduceM (Blocked' Term t))
-> Dom t -> ReduceM (Dom' Term (Blocked' Term t))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Dom' Term a -> f (Dom' Term b)
traverse t -> ReduceM (Blocked' Term 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' (a
x,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 a b. ReduceM (a -> b) -> ReduceM a -> ReduceM 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' (a
x,b
y) = do
x <- a -> ReduceM (Blocked a)
forall t. Reduce t => t -> ReduceM (Blocked t)
reduceB' a
x
y <- reduceB' y
let blk = Blocked a -> Blocked' Term ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Blocked a
x Blocked' Term () -> Blocked' Term () -> Blocked' Term ()
forall a. Monoid a => a -> a -> a
`mappend` Blocked b -> Blocked' Term ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Blocked b
y
xy = (Blocked a -> a
forall t a. Blocked' t a -> a
ignoreBlocking Blocked a
x , Blocked b -> b
forall t a. Blocked' t a -> a
ignoreBlocking Blocked b
y)
return $ blk $> xy
instance (Reduce a, Reduce b,Reduce c) => Reduce (a,b,c) where
reduce' :: (a, b, c) -> ReduceM (a, b, c)
reduce' (a
x,b
y,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 a b. ReduceM (a -> b) -> ReduceM a -> ReduceM 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 ReduceM (c -> (a, b, c)) -> ReduceM c -> ReduceM (a, b, c)
forall a b. ReduceM (a -> b) -> ReduceM a -> ReduceM b
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' (a
x,b
y,c
z) = do
x <- a -> ReduceM (Blocked a)
forall t. Reduce t => t -> ReduceM (Blocked t)
reduceB' a
x
y <- reduceB' y
z <- reduceB' z
let blk = Blocked a -> Blocked' Term ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Blocked a
x Blocked' Term () -> Blocked' Term () -> Blocked' Term ()
forall a. Monoid a => a -> a -> a
`mappend` Blocked b -> Blocked' Term ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Blocked b
y Blocked' Term () -> Blocked' Term () -> Blocked' Term ()
forall a. Monoid a => a -> a -> a
`mappend` Blocked c -> Blocked' Term ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Blocked c
z
xyz = (Blocked a -> a
forall t a. Blocked' t a -> a
ignoreBlocking Blocked a
x , Blocked b -> b
forall t a. Blocked' t a -> a
ignoreBlocking Blocked b
y , Blocked c -> c
forall t a. Blocked' t a -> a
ignoreBlocking Blocked c
z)
return $ blk $> xyz
reduceIApply :: ReduceM (Blocked Term) -> [Elim] -> ReduceM (Blocked Term)
reduceIApply :: ReduceM (Blocked' Term Term)
-> Elims -> ReduceM (Blocked' Term Term)
reduceIApply = (Term -> ReduceM (Blocked' Term Term))
-> ReduceM (Blocked' Term Term)
-> Elims
-> ReduceM (Blocked' Term Term)
reduceIApply' Term -> ReduceM (Blocked' Term Term)
forall t. Reduce t => t -> ReduceM (Blocked t)
reduceB'
reduceIApply' :: (Term -> ReduceM (Blocked Term)) -> ReduceM (Blocked Term) -> [Elim] -> ReduceM (Blocked Term)
reduceIApply' :: (Term -> ReduceM (Blocked' Term Term))
-> ReduceM (Blocked' Term Term)
-> Elims
-> ReduceM (Blocked' Term Term)
reduceIApply' Term -> ReduceM (Blocked' Term Term)
red ReduceM (Blocked' Term Term)
d (IApply Term
x Term
y Term
r : Elims
es) = do
view <- ReduceM (Term -> IntervalView)
forall (m :: * -> *). HasBuiltins m => m (Term -> IntervalView)
intervalView'
r <- reduceB' r
case view (ignoreBlocking r) of
IntervalView
IZero -> Term -> ReduceM (Blocked' Term Term)
red (Term -> Elims -> Term
forall t. Apply t => t -> Elims -> t
applyE Term
x Elims
es)
IntervalView
IOne -> Term -> ReduceM (Blocked' Term Term)
red (Term -> Elims -> Term
forall t. Apply t => t -> Elims -> t
applyE Term
y Elims
es)
IntervalView
_ -> (Blocked' Term Term -> Blocked' Term Term)
-> ReduceM (Blocked' Term Term) -> ReduceM (Blocked' Term Term)
forall a b. (a -> b) -> ReduceM a -> ReduceM b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Blocked' Term Term -> Blocked' Term Term -> Blocked' Term Term
forall a b. Blocked' Term a -> Blocked' Term b -> Blocked' Term a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Blocked' Term Term
r) ((Term -> ReduceM (Blocked' Term Term))
-> ReduceM (Blocked' Term Term)
-> Elims
-> ReduceM (Blocked' Term Term)
reduceIApply' Term -> ReduceM (Blocked' Term Term)
red ReduceM (Blocked' Term Term)
d Elims
es)
reduceIApply' Term -> ReduceM (Blocked' Term Term)
red ReduceM (Blocked' Term Term)
d (Elim
_ : Elims
es) = (Term -> ReduceM (Blocked' Term Term))
-> ReduceM (Blocked' Term Term)
-> Elims
-> ReduceM (Blocked' Term Term)
reduceIApply' Term -> ReduceM (Blocked' Term Term)
red ReduceM (Blocked' Term Term)
d Elims
es
reduceIApply' Term -> ReduceM (Blocked' Term Term)
_ ReduceM (Blocked' Term Term)
d [] = ReduceM (Blocked' Term Term)
d
instance Reduce DeBruijnPattern where
reduceB' :: DeBruijnPattern -> ReduceM (Blocked DeBruijnPattern)
reduceB' (DotP PatternInfo
o Term
v) = (Term -> DeBruijnPattern)
-> Blocked' Term Term -> Blocked DeBruijnPattern
forall a b. (a -> b) -> Blocked' Term a -> Blocked' Term b
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 Term -> Blocked DeBruijnPattern)
-> ReduceM (Blocked' Term Term)
-> ReduceM (Blocked DeBruijnPattern)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term -> ReduceM (Blocked' Term Term)
forall t. Reduce t => t -> ReduceM (Blocked t)
reduceB' Term
v
reduceB' DeBruijnPattern
p = Blocked DeBruijnPattern -> ReduceM (Blocked DeBruijnPattern)
forall a. a -> ReduceM a
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 t. a -> Blocked' t a
notBlocked DeBruijnPattern
p
instance Reduce Term where
reduceB' :: Term -> ReduceM (Blocked' Term Term)
reduceB' = {-# SCC "reduce'<Term>" #-} Term -> ReduceM (Blocked' Term 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
maybeFastReduceTerm :: Term -> ReduceM (Blocked Term)
maybeFastReduceTerm :: Term -> ReduceM (Blocked' Term Term)
maybeFastReduceTerm Term
v = do
let tryFast :: Bool
tryFast = case Term
v of
Def{} -> Bool
True
Con{} -> Bool
True
MetaV{} -> Bool
True
Term
_ -> Bool
False
if Bool -> Bool
not Bool
tryFast then Term -> ReduceM (Blocked' Term Term)
slowReduceTerm Term
v
else
case Term
v of
MetaV MetaId
x Elims
_ -> ReduceM Bool
-> ReduceM (Blocked' Term Term)
-> ReduceM (Blocked' Term Term)
-> ReduceM (Blocked' Term Term)
forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifM (MetaId -> ReduceM Bool
forall {f :: * -> *}. ReadTCState f => MetaId -> f Bool
isOpen MetaId
x) (Blocked' Term Term -> ReduceM (Blocked' Term Term)
forall a. a -> ReduceM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocked' Term Term -> ReduceM (Blocked' Term Term))
-> Blocked' Term Term -> ReduceM (Blocked' Term Term)
forall a b. (a -> b) -> a -> b
$ MetaId -> Term -> Blocked' Term Term
forall a t. MetaId -> a -> Blocked' t a
blocked MetaId
x Term
v) (Term -> ReduceM (Blocked' Term Term)
maybeFast Term
v)
Term
_ -> Term -> ReduceM (Blocked' Term Term)
maybeFast Term
v
where
isOpen :: MetaId -> f Bool
isOpen MetaId
x = MetaInstantiation -> Bool
isOpenMeta (MetaInstantiation -> Bool) -> f MetaInstantiation -> f Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MetaId -> f MetaInstantiation
forall (m :: * -> *).
ReadTCState m =>
MetaId -> m MetaInstantiation
lookupMetaInstantiation MetaId
x
maybeFast :: Term -> ReduceM (Blocked' Term Term)
maybeFast Term
v = ReduceM Bool
-> ReduceM (Blocked' Term Term)
-> ReduceM (Blocked' Term Term)
-> ReduceM (Blocked' Term Term)
forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifM ReduceM Bool
shouldTryFastReduce (Term -> ReduceM (Blocked' Term Term)
fastReduce Term
v) (Term -> ReduceM (Blocked' Term Term)
slowReduceTerm Term
v)
slowReduceTerm :: Term -> ReduceM (Blocked Term)
slowReduceTerm :: Term -> ReduceM (Blocked' Term Term)
slowReduceTerm Term
v = do
v <- Term -> ReduceM Term
forall t. Instantiate t => t -> ReduceM t
instantiate' Term
v
let done | MetaV MetaId
x Elims
_ <- Term
v = Blocked' Term Term -> ReduceM (Blocked' Term Term)
forall a. a -> ReduceM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocked' Term Term -> ReduceM (Blocked' Term Term))
-> Blocked' Term Term -> ReduceM (Blocked' Term Term)
forall a b. (a -> b) -> a -> b
$ MetaId -> Term -> Blocked' Term Term
forall a t. MetaId -> a -> Blocked' t a
blocked MetaId
x Term
v
| Bool
otherwise = Blocked' Term Term -> ReduceM (Blocked' Term Term)
forall a. a -> ReduceM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocked' Term Term -> ReduceM (Blocked' Term Term))
-> Blocked' Term Term -> ReduceM (Blocked' Term Term)
forall a b. (a -> b) -> a -> b
$ Term -> Blocked' Term Term
forall a t. a -> Blocked' t a
notBlocked Term
v
iapp = ReduceM (Blocked' Term Term)
-> Elims -> ReduceM (Blocked' Term Term)
reduceIApply ReduceM (Blocked' Term Term)
done
case v of
MetaV MetaId
x Elims
es -> Elims -> ReduceM (Blocked' Term Term)
iapp Elims
es
Def QName
f Elims
es -> (ReduceM (Blocked' Term Term)
-> Elims -> ReduceM (Blocked' Term Term))
-> Elims
-> ReduceM (Blocked' Term Term)
-> ReduceM (Blocked' Term Term)
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReduceM (Blocked' Term Term)
-> Elims -> ReduceM (Blocked' Term Term)
reduceIApply Elims
es (ReduceM (Blocked' Term Term) -> ReduceM (Blocked' Term Term))
-> ReduceM (Blocked' Term Term) -> ReduceM (Blocked' Term Term)
forall a b. (a -> b) -> a -> b
$ (Term -> ReduceM (Blocked' Term Term))
-> Term -> QName -> Elims -> ReduceM (Blocked' Term Term)
unfoldDefinitionE Term -> ReduceM (Blocked' Term Term)
forall t. Reduce t => t -> ReduceM (Blocked t)
reduceB' (QName -> Elims -> Term
Def QName
f []) QName
f Elims
es
Con ConHead
c ConInfo
ci Elims
es -> do
v <- (ReduceM (Blocked' Term Term)
-> Elims -> ReduceM (Blocked' Term Term))
-> Elims
-> ReduceM (Blocked' Term Term)
-> ReduceM (Blocked' Term Term)
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReduceM (Blocked' Term Term)
-> Elims -> ReduceM (Blocked' Term Term)
reduceIApply Elims
es
(ReduceM (Blocked' Term Term) -> ReduceM (Blocked' Term Term))
-> ReduceM (Blocked' Term Term) -> ReduceM (Blocked' Term Term)
forall a b. (a -> b) -> a -> b
$ (Term -> ReduceM (Blocked' Term Term))
-> Term -> QName -> Elims -> ReduceM (Blocked' Term Term)
unfoldDefinitionE Term -> ReduceM (Blocked' Term 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
traverse reduceNat v
Sort Sort
s -> ReduceM (Blocked' Term Term)
done
Level Level
l -> ReduceM Bool
-> ReduceM (Blocked' Term Term)
-> ReduceM (Blocked' Term Term)
-> ReduceM (Blocked' Term Term)
forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifM (AllowedReduction -> SmallSet AllowedReduction -> Bool
forall a. SmallSetElement a => a -> SmallSet a -> Bool
SmallSet.member AllowedReduction
LevelReductions (SmallSet AllowedReduction -> Bool)
-> ReduceM (SmallSet AllowedReduction) -> ReduceM Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (TCEnv -> SmallSet AllowedReduction)
-> ReduceM (SmallSet AllowedReduction)
forall (m :: * -> *) a. MonadTCEnv m => (TCEnv -> a) -> m a
asksTC TCEnv -> SmallSet AllowedReduction
envAllowedReductions)
((Level -> Term) -> Blocked Level -> Blocked' Term Term
forall a b. (a -> b) -> Blocked' Term a -> Blocked' Term b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Level -> Term
levelTm (Blocked Level -> Blocked' Term Term)
-> ReduceM (Blocked Level) -> ReduceM (Blocked' Term 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 Term)
done
Pi Dom Type
_ Abs Type
_ -> ReduceM (Blocked' Term Term)
done
Lit Literal
_ -> ReduceM (Blocked' Term Term)
done
Var Int
_ Elims
es -> Elims -> ReduceM (Blocked' Term Term)
iapp Elims
es
Lam ArgInfo
_ Abs Term
_ -> ReduceM (Blocked' Term Term)
done
DontCare Term
_ -> ReduceM (Blocked' Term Term)
done
Dummy{} -> ReduceM (Blocked' Term Term)
done
where
reduceNat :: Term -> ReduceM Term
reduceNat v :: Term
v@(Con ConHead
c ConInfo
ci []) = do
mz <- BuiltinId -> ReduceM (Maybe Term)
forall (m :: * -> *). HasBuiltins m => BuiltinId -> m (Maybe Term)
getBuiltin' BuiltinId
builtinZero
case v of
Term
_ | 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 a. a -> ReduceM a
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
$ Integer -> Literal
LitNat Integer
0
Term
_ -> Term -> ReduceM Term
forall a. a -> ReduceM a
forall (m :: * -> *) a. Monad m => a -> m a
return Term
v
reduceNat v :: Term
v@(Con ConHead
c ConInfo
ci [Apply 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
ms <- BuiltinId -> ReduceM (Maybe Term)
forall (m :: * -> *). HasBuiltins m => BuiltinId -> m (Maybe Term)
getBuiltin' BuiltinId
builtinSuc
case v of
Term
_ | 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
_ -> Term -> ReduceM Term
forall a. a -> ReduceM a
forall (m :: * -> *) a. Monad m => a -> m a
return Term
v
where
inc :: Term -> Term
inc = \case
Lit (LitNat Integer
n) -> Literal -> Term
Lit (Literal -> Term) -> Literal -> Term
forall a b. (a -> b) -> a -> b
$ Integer -> Literal
LitNat (Integer -> Literal) -> Integer -> Literal
forall a b. (a -> b) -> a -> b
$ Integer
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1
Term
w -> 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 Term
v = Term -> ReduceM Term
forall a. a -> ReduceM a
forall (m :: * -> *) a. Monad m => a -> m a
return Term
v
unfoldCorecursionE :: Elim -> ReduceM (Blocked Elim)
unfoldCorecursionE :: Elim -> ReduceM (Blocked Elim)
unfoldCorecursionE (Proj ProjOrigin
o QName
p) = Elim -> Blocked Elim
forall a t. a -> Blocked' t 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 ArgInfo
info Term
v)) = (Term -> Elim) -> Blocked' Term Term -> Blocked Elim
forall a b. (a -> b) -> Blocked' Term a -> Blocked' Term b
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 Term -> Blocked Elim)
-> ReduceM (Blocked' Term Term) -> ReduceM (Blocked Elim)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
Term -> ReduceM (Blocked' Term Term)
unfoldCorecursion Term
v
unfoldCorecursionE (IApply Term
x Term
y Term
r) = do
[x,y,r] <- (Term -> ReduceM (Blocked' Term Term))
-> [Term] -> ReduceM [Blocked' Term Term]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Term -> ReduceM (Blocked' Term Term)
unfoldCorecursion [Term
x,Term
y,Term
r]
return $ IApply <$> x <*> y <*> r
unfoldCorecursion :: Term -> ReduceM (Blocked Term)
unfoldCorecursion :: Term -> ReduceM (Blocked' Term Term)
unfoldCorecursion Term
v = do
v <- Term -> ReduceM Term
forall t. Instantiate t => t -> ReduceM t
instantiate' Term
v
case v of
Def QName
f Elims
es -> (Term -> ReduceM (Blocked' Term Term))
-> Term -> QName -> Elims -> ReduceM (Blocked' Term Term)
unfoldDefinitionE Term -> ReduceM (Blocked' Term Term)
unfoldCorecursion (QName -> Elims -> Term
Def QName
f []) QName
f Elims
es
Term
_ -> Term -> ReduceM (Blocked' Term Term)
slowReduceTerm Term
v
unfoldDefinition ::
(Term -> ReduceM (Blocked Term)) ->
Term -> QName -> Args -> ReduceM (Blocked Term)
unfoldDefinition :: (Term -> ReduceM (Blocked' Term Term))
-> Term -> QName -> [Arg Term] -> ReduceM (Blocked' Term Term)
unfoldDefinition Term -> ReduceM (Blocked' Term Term)
keepGoing Term
v QName
f [Arg Term]
args =
(Term -> ReduceM (Blocked' Term Term))
-> Term -> QName -> Elims -> ReduceM (Blocked' Term Term)
unfoldDefinitionE Term -> ReduceM (Blocked' Term 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 ::
(Term -> ReduceM (Blocked Term)) ->
Term -> QName -> Elims -> ReduceM (Blocked Term)
unfoldDefinitionE :: (Term -> ReduceM (Blocked' Term Term))
-> Term -> QName -> Elims -> ReduceM (Blocked' Term Term)
unfoldDefinitionE Term -> ReduceM (Blocked' Term Term)
keepGoing Term
v QName
f Elims
es = do
r <- Term
-> QName -> Elims -> ReduceM (Reduced (Blocked' Term Term) Term)
unfoldDefinitionStep Term
v QName
f Elims
es
case r of
NoReduction Blocked' Term Term
v -> Blocked' Term Term -> ReduceM (Blocked' Term Term)
forall a. a -> ReduceM a
forall (m :: * -> *) a. Monad m => a -> m a
return Blocked' Term Term
v
YesReduction Simplification
_ Term
v -> Term -> ReduceM (Blocked' Term Term)
keepGoing Term
v
unfoldDefinition' ::
(Simplification -> Term -> ReduceM (Simplification, Blocked Term)) ->
Term -> QName -> Elims -> ReduceM (Simplification, Blocked Term)
unfoldDefinition' :: (Simplification
-> Term -> ReduceM (Simplification, Blocked' Term Term))
-> Term
-> QName
-> Elims
-> ReduceM (Simplification, Blocked' Term Term)
unfoldDefinition' Simplification
-> Term -> ReduceM (Simplification, Blocked' Term Term)
keepGoing Term
v0 QName
f Elims
es = do
r <- Term
-> QName -> Elims -> ReduceM (Reduced (Blocked' Term Term) Term)
unfoldDefinitionStep Term
v0 QName
f Elims
es
case r of
NoReduction Blocked' Term Term
v -> (Simplification, Blocked' Term Term)
-> ReduceM (Simplification, Blocked' Term Term)
forall a. a -> ReduceM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Simplification
NoSimplification, Blocked' Term Term
v)
YesReduction Simplification
simp Term
v -> Simplification
-> Term -> ReduceM (Simplification, Blocked' Term Term)
keepGoing Simplification
simp Term
v
unfoldDefinitionStep :: Term -> QName -> Elims -> ReduceM (Reduced (Blocked Term) Term)
unfoldDefinitionStep :: Term
-> QName -> Elims -> ReduceM (Reduced (Blocked' Term Term) Term)
unfoldDefinitionStep Term
v0 QName
f Elims
es =
{-# SCC "reduceDef" #-} do
[Char]
-> Int
-> TCMT IO Doc
-> ReduceM (Reduced (Blocked' Term Term) Term)
-> ReduceM (Reduced (Blocked' Term Term) Term)
forall (m :: * -> *) a.
MonadDebug m =>
[Char] -> Int -> TCMT IO Doc -> m a -> m a
traceSDoc [Char]
"tc.reduce" Int
90 (TCMT IO Doc
"unfoldDefinitionStep v0" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> Term -> TCMT IO Doc
forall (m :: * -> *) a. (Applicative m, Pretty a) => a -> m Doc
pretty Term
v0) (ReduceM (Reduced (Blocked' Term Term) Term)
-> ReduceM (Reduced (Blocked' Term Term) Term))
-> ReduceM (Reduced (Blocked' Term Term) Term)
-> ReduceM (Reduced (Blocked' Term Term) Term)
forall a b. (a -> b) -> a -> b
$ do
info <- QName -> ReduceM Definition
forall (m :: * -> *). HasConstInfo m => QName -> m Definition
getConstInfo QName
f
rewr <- instantiateRewriteRules =<< getRewriteRulesFor f
allowed <- asksTC envAllowedReductions
prp <- runBlocked $ isPropM $ defType info
defOk <- shouldReduceDef f
let def = Definition -> Defn
theDef Definition
info
v = Term
v0 Term -> Elims -> Term
forall t. Apply t => t -> Elims -> t
`applyE` Elims
es
dontUnfold = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or
[ Definition -> Bool
defNonterminating Definition
info Bool -> Bool -> Bool
&& AllowedReduction -> SmallSet AllowedReduction -> Bool
forall a. SmallSetElement a => a -> SmallSet a -> Bool
SmallSet.notMember AllowedReduction
NonTerminatingReductions SmallSet AllowedReduction
allowed
, Definition -> Bool
defTerminationUnconfirmed Definition
info Bool -> Bool -> Bool
&& AllowedReduction -> SmallSet AllowedReduction -> Bool
forall a. SmallSetElement a => a -> SmallSet a -> Bool
SmallSet.notMember AllowedReduction
UnconfirmedReductions SmallSet AllowedReduction
allowed
, Either Blocker Bool
prp Either Blocker Bool -> Either Blocker Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool -> Either Blocker Bool
forall a b. b -> Either a b
Right Bool
True
, Definition -> Bool
forall a. LensRelevance a => a -> Bool
isIrrelevant Definition
info
, Bool -> Bool
not Bool
defOk
]
copatterns = Definition -> Bool
defCopatternLHS Definition
info
case def of
Constructor{conSrcCon :: Defn -> ConHead
conSrcCon = ConHead
c} -> do
let hd :: Elims -> Term
hd = 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
Blocked' Term ()
-> (Elims -> Term)
-> RewriteRules
-> Elims
-> ReduceM (Reduced (Blocked' Term Term) Term)
rewrite (NotBlocked -> () -> Blocked' Term ()
forall t a. NotBlocked' t -> a -> Blocked' t a
NotBlocked NotBlocked
forall t. NotBlocked' t
ReallyNotBlocked ()) Elims -> Term
hd RewriteRules
rewr Elims
es
Primitive{primAbstr :: Defn -> IsAbstract
primAbstr = IsAbstract
ConcreteDef, primName :: Defn -> PrimitiveId
primName = PrimitiveId
x, primClauses :: Defn -> [Clause]
primClauses = [Clause]
cls} -> do
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
<$> PrimitiveId -> ReduceM (Maybe PrimFun)
forall (m :: * -> *).
HasBuiltins m =>
PrimitiveId -> m (Maybe PrimFun)
getPrimitive' PrimitiveId
x
if FunctionReductions `SmallSet.member` allowed
then reducePrimitive x v0 f es pf dontUnfold
cls (defCompiled info) rewr
else noReduction $ notBlocked v
PrimitiveSort{ primSortSort :: Defn -> Sort
primSortSort = Sort
s } -> Simplification
-> Term -> ReduceM (Reduced (Blocked' Term Term) Term)
forall {m :: * -> *} {a} {no}.
Monad m =>
Simplification -> a -> m (Reduced no a)
yesReduction Simplification
NoSimplification (Term -> ReduceM (Reduced (Blocked' Term Term) Term))
-> Term -> ReduceM (Reduced (Blocked' Term Term) Term)
forall a b. (a -> b) -> a -> b
$ Sort -> Term
Sort Sort
s Term -> Elims -> Term
forall t. Apply t => t -> Elims -> t
`applyE` Elims
es
Defn
_ -> do
if [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or
[ AllowedReduction
RecursiveReductions AllowedReduction -> SmallSet AllowedReduction -> Bool
forall a. SmallSetElement a => a -> SmallSet a -> Bool
`SmallSet.member` SmallSet AllowedReduction
allowed
, Maybe Projection -> Bool
forall a. Maybe a -> Bool
isJust (Defn -> Maybe Projection
isProjection_ Defn
def) Bool -> Bool -> Bool
&& AllowedReduction
ProjectionReductions AllowedReduction -> SmallSet AllowedReduction -> Bool
forall a. SmallSetElement a => a -> SmallSet a -> Bool
`SmallSet.member` SmallSet AllowedReduction
allowed
, Defn -> Bool
isInlineFun Defn
def Bool -> Bool -> Bool
&& AllowedReduction
InlineReductions AllowedReduction -> SmallSet AllowedReduction -> Bool
forall a. SmallSetElement a => a -> SmallSet a -> Bool
`SmallSet.member` SmallSet AllowedReduction
allowed
, Defn -> Bool
definitelyNonRecursive_ Defn
def Bool -> Bool -> Bool
&& [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or
[ Bool
copatterns Bool -> Bool -> Bool
&& AllowedReduction
CopatternReductions AllowedReduction -> SmallSet AllowedReduction -> Bool
forall a. SmallSetElement a => a -> SmallSet a -> Bool
`SmallSet.member` SmallSet AllowedReduction
allowed
, AllowedReduction
FunctionReductions AllowedReduction -> SmallSet AllowedReduction -> Bool
forall a. SmallSetElement a => a -> SmallSet a -> Bool
`SmallSet.member` SmallSet AllowedReduction
allowed
]
]
then
Term
-> QName
-> [MaybeReduced Elim]
-> Bool
-> [Clause]
-> Maybe CompiledClauses
-> RewriteRules
-> ReduceM (Reduced (Blocked' Term 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 Term -> ReduceM (Reduced (Blocked' Term Term) Term)
forall {a} {yes}. a -> ReduceM (Reduced a yes)
noReduction (Blocked' Term Term -> ReduceM (Reduced (Blocked' Term Term) Term))
-> Blocked' Term Term
-> ReduceM (Reduced (Blocked' Term Term) Term)
forall a b. (a -> b) -> a -> b
$ Term -> Blocked' Term Term
forall a t. a -> Blocked' t a
notBlocked Term
v
where
noReduction :: a -> ReduceM (Reduced a yes)
noReduction = Reduced a yes -> ReduceM (Reduced a yes)
forall a. a -> ReduceM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Reduced a yes -> ReduceM (Reduced a yes))
-> (a -> Reduced a yes) -> a -> ReduceM (Reduced a yes)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Reduced a yes
forall no yes. no -> Reduced no yes
NoReduction
yesReduction :: Simplification -> a -> m (Reduced no a)
yesReduction Simplification
s = Reduced no a -> m (Reduced no a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Reduced no a -> m (Reduced no a))
-> (a -> Reduced no a) -> a -> m (Reduced no a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Simplification -> a -> Reduced no a
forall no yes. Simplification -> yes -> Reduced no yes
YesReduction Simplification
s
reducePrimitive :: PrimitiveId
-> Term
-> QName
-> Elims
-> PrimFun
-> Bool
-> [Clause]
-> Maybe CompiledClauses
-> RewriteRules
-> ReduceM (Reduced (Blocked' Term Term) Term)
reducePrimitive PrimitiveId
x Term
v0 QName
f Elims
es PrimFun
pf Bool
dontUnfold [Clause]
cls Maybe CompiledClauses
mcc RewriteRules
rewr
| Elims -> Int
forall a. [a] -> 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 Term -> ReduceM (Reduced (Blocked' Term Term) Term)
forall {a} {yes}. a -> ReduceM (Reduced a yes)
noReduction (Blocked' Term Term -> ReduceM (Reduced (Blocked' Term Term) Term))
-> Blocked' Term Term
-> ReduceM (Reduced (Blocked' Term Term) Term)
forall a b. (a -> b) -> a -> b
$ NotBlocked -> Term -> Blocked' Term Term
forall t a. NotBlocked' t -> a -> Blocked' t a
NotBlocked NotBlocked
forall t. NotBlocked' t
Underapplied (Term -> Blocked' Term Term) -> Term -> Blocked' Term 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 (Elims
es1,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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Elim -> Maybe (Arg Term)
forall a. Elim' a -> Maybe (Arg a)
isApplyElim Elims
es1
r <- PrimFun
-> [Arg Term] -> Int -> ReduceM (Reduced MaybeReducedArgs Term)
primFunImplementation PrimFun
pf [Arg Term]
args1 (Elims -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Elims
es2)
case r of
NoReduction 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 a b. (a -> b) -> MaybeReduced a -> MaybeReduced b
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 a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Clause]
cls Bool -> Bool -> Bool
&& RewriteRules -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null RewriteRules
rewr then do
Blocked' Term Term -> ReduceM (Reduced (Blocked' Term Term) Term)
forall {a} {yes}. a -> ReduceM (Reduced a yes)
noReduction (Blocked' Term Term -> ReduceM (Reduced (Blocked' Term Term) Term))
-> Blocked' Term Term
-> ReduceM (Reduced (Blocked' Term 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' Term Elims -> Blocked' Term Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
[Blocked Elim] -> Blocked' Term Elims
forall (f :: * -> *) a.
(Functor f, Foldable f) =>
f (Blocked a) -> Blocked (f a)
blockAll ([Blocked Elim] -> Blocked' Term Elims)
-> [Blocked Elim] -> Blocked' Term 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 t. IsMeta t => MaybeReduced t -> Blocked t
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 t. a -> Blocked' t a
notBlocked Elims
es2
else
Term
-> QName
-> [MaybeReduced Elim]
-> Bool
-> [Clause]
-> Maybe CompiledClauses
-> RewriteRules
-> ReduceM (Reduced (Blocked' Term 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 Simplification
simpl Term
v -> Simplification
-> Term -> ReduceM (Reduced (Blocked' Term Term) Term)
forall {m :: * -> *} {a} {no}.
Monad m =>
Simplification -> a -> m (Reduced no a)
yesReduction Simplification
simpl (Term -> ReduceM (Reduced (Blocked' Term Term) Term))
-> Term -> ReduceM (Reduced (Blocked' Term 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 :: IsMeta t => MaybeReduced t -> Blocked t
mredToBlocked :: forall t. IsMeta t => MaybeReduced t -> Blocked t
mredToBlocked (MaybeRed IsReduced
NotReduced t
e) = t -> Blocked' Term t
forall a t. a -> Blocked' t a
notBlocked t
e
mredToBlocked (MaybeRed (Reduced Blocked' Term ()
b) t
e) = t
e t -> Blocked' Term () -> Blocked' Term t
forall a b. a -> Blocked' Term b -> Blocked' Term a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Blocked' Term ()
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) Term)
reduceNormalE Term
v0 QName
f [MaybeReduced Elim]
es Bool
dontUnfold [Clause]
def Maybe CompiledClauses
mcc RewriteRules
rewr = {-# SCC "reduceNormal" #-} do
[Char]
-> Int
-> TCMT IO Doc
-> ReduceM (Reduced (Blocked' Term Term) Term)
-> ReduceM (Reduced (Blocked' Term Term) Term)
forall (m :: * -> *) a.
MonadDebug m =>
[Char] -> Int -> TCMT IO Doc -> m a -> m a
traceSDoc [Char]
"tc.reduce" Int
90 (TCMT IO Doc
"reduceNormalE v0 =" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> Term -> TCMT IO Doc
forall (m :: * -> *) a. (Applicative m, Pretty a) => a -> m Doc
pretty Term
v0) (ReduceM (Reduced (Blocked' Term Term) Term)
-> ReduceM (Reduced (Blocked' Term Term) Term))
-> ReduceM (Reduced (Blocked' Term Term) Term)
-> ReduceM (Reduced (Blocked' Term Term) Term)
forall a b. (a -> b) -> a -> b
$ do
case ([Clause]
def,RewriteRules
rewr) of
([Clause], RewriteRules)
_ | Bool
dontUnfold -> [Char]
-> Int
-> [Char]
-> ReduceM (Reduced (Blocked' Term Term) Term)
-> ReduceM (Reduced (Blocked' Term Term) Term)
forall (m :: * -> *) a.
MonadDebug m =>
[Char] -> Int -> [Char] -> m a -> m a
traceSLn [Char]
"tc.reduce" Int
90 [Char]
"reduceNormalE: don't unfold (non-terminating or delayed)" (ReduceM (Reduced (Blocked' Term Term) Term)
-> ReduceM (Reduced (Blocked' Term Term) Term))
-> ReduceM (Reduced (Blocked' Term Term) Term)
-> ReduceM (Reduced (Blocked' Term Term) Term)
forall a b. (a -> b) -> a -> b
$
ReduceM (Reduced (Blocked' Term Term) Term)
defaultResult
([],[]) -> [Char]
-> Int
-> [Char]
-> ReduceM (Reduced (Blocked' Term Term) Term)
-> ReduceM (Reduced (Blocked' Term Term) Term)
forall (m :: * -> *) a.
MonadDebug m =>
[Char] -> Int -> [Char] -> m a -> m a
traceSLn [Char]
"tc.reduce" Int
90 [Char]
"reduceNormalE: no clauses or rewrite rules" (ReduceM (Reduced (Blocked' Term Term) Term)
-> ReduceM (Reduced (Blocked' Term Term) Term))
-> ReduceM (Reduced (Blocked' Term Term) Term)
-> ReduceM (Reduced (Blocked' Term Term) Term)
forall a b. (a -> b) -> a -> b
$ do
(Definition -> Blocked' Term ()
defBlocked (Definition -> Blocked' Term ())
-> ReduceM Definition -> ReduceM (Blocked' Term ())
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) ReduceM (Blocked' Term ())
-> (Blocked' Term ()
-> ReduceM (Reduced (Blocked' Term Term) Term))
-> ReduceM (Reduced (Blocked' Term Term) Term)
forall a b. ReduceM a -> (a -> ReduceM b) -> ReduceM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Blocked{} -> Blocked' Term Term -> ReduceM (Reduced (Blocked' Term Term) Term)
forall {a} {yes}. a -> ReduceM (Reduced a yes)
noReduction (Blocked' Term Term -> ReduceM (Reduced (Blocked' Term Term) Term))
-> Blocked' Term Term
-> ReduceM (Reduced (Blocked' Term Term) Term)
forall a b. (a -> b) -> a -> b
$ Blocker -> Term -> Blocked' Term Term
forall t a. Blocker -> a -> Blocked' t a
Blocked (QName -> Blocker
UnblockOnDef QName
f) Term
vfull
NotBlocked{} -> ReduceM (Reduced (Blocked' Term Term) Term)
defaultResult
([Clause]
cls,RewriteRules
rewr) -> do
ev <- QName
-> Term
-> [Clause]
-> Maybe CompiledClauses
-> RewriteRules
-> [MaybeReduced Elim]
-> ReduceM (Reduced (Blocked' Term Term) Term)
appDefE_ QName
f Term
v0 [Clause]
cls Maybe CompiledClauses
mcc RewriteRules
rewr [MaybeReduced Elim]
es
debugReduce ev
return ev
where
defaultResult :: ReduceM (Reduced (Blocked' Term Term) Term)
defaultResult = Blocked' Term Term -> ReduceM (Reduced (Blocked' Term Term) Term)
forall {a} {yes}. a -> ReduceM (Reduced a yes)
noReduction (Blocked' Term Term -> ReduceM (Reduced (Blocked' Term Term) Term))
-> Blocked' Term Term
-> ReduceM (Reduced (Blocked' Term Term) Term)
forall a b. (a -> b) -> a -> b
$ NotBlocked -> Term -> Blocked' Term Term
forall t a. NotBlocked' t -> a -> Blocked' t a
NotBlocked NotBlocked
forall t. NotBlocked' t
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) Term -> ReduceM ()
debugReduce Reduced (Blocked' Term Term) Term
ev = [Char] -> Int -> ReduceM () -> ReduceM ()
forall (m :: * -> *). MonadDebug m => [Char] -> Int -> m () -> m ()
verboseS [Char]
"tc.reduce" Int
90 (ReduceM () -> ReduceM ()) -> ReduceM () -> ReduceM ()
forall a b. (a -> b) -> a -> b
$ do
case Reduced (Blocked' Term Term) Term
ev of
NoReduction Blocked' Term Term
v -> do
[Char] -> Int -> TCMT IO Doc -> ReduceM ()
forall (m :: * -> *).
MonadDebug m =>
[Char] -> Int -> TCMT IO Doc -> m ()
reportSDoc [Char]
"tc.reduce" Int
90 (TCMT IO Doc -> ReduceM ()) -> TCMT IO Doc -> ReduceM ()
forall a b. (a -> b) -> a -> b
$ [TCMT IO Doc] -> TCMT IO Doc
forall (m :: * -> *) (t :: * -> *).
(Applicative m, Foldable t) =>
t (m Doc) -> m Doc
vcat
[ TCMT IO Doc
"*** tried to reduce " TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> QName -> TCMT IO Doc
forall (m :: * -> *) a. (Applicative m, Pretty a) => a -> m Doc
pretty QName
f
, TCMT IO Doc
" es = " TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> [TCMT IO Doc] -> TCMT IO Doc
forall (m :: * -> *) (t :: * -> *).
(Applicative m, Foldable t) =>
t (m Doc) -> m Doc
sep ((MaybeReduced Elim -> TCMT IO Doc)
-> [MaybeReduced Elim] -> [TCMT IO Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Elim -> TCMT IO Doc
forall (m :: * -> *) a. (Applicative m, Pretty a) => a -> m Doc
pretty (Elim -> TCMT IO Doc)
-> (MaybeReduced Elim -> Elim) -> MaybeReduced Elim -> TCMT IO Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MaybeReduced Elim -> Elim
forall a. MaybeReduced a -> a
ignoreReduced) [MaybeReduced Elim]
es)
, TCMT IO Doc
" stuck on" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> Term -> TCMT IO Doc
forall (m :: * -> *) a. (Applicative m, Pretty a) => a -> m Doc
pretty (Blocked' Term Term -> Term
forall t a. Blocked' t a -> a
ignoreBlocking Blocked' Term Term
v)
]
YesReduction Simplification
_simpl Term
v -> do
[Char] -> Int -> TCMT IO Doc -> ReduceM ()
forall (m :: * -> *).
MonadDebug m =>
[Char] -> Int -> TCMT IO Doc -> m ()
reportSDoc [Char]
"tc.reduce" Int
90 (TCMT IO Doc -> ReduceM ()) -> TCMT IO Doc -> ReduceM ()
forall a b. (a -> b) -> a -> b
$ TCMT IO Doc
"*** reduced definition: " TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> QName -> TCMT IO Doc
forall (m :: * -> *) a. (Applicative m, Pretty a) => a -> m Doc
pretty QName
f
[Char] -> Int -> TCMT IO Doc -> ReduceM ()
forall (m :: * -> *).
MonadDebug m =>
[Char] -> Int -> TCMT IO Doc -> m ()
reportSDoc [Char]
"tc.reduce" Int
95 (TCMT IO Doc -> ReduceM ()) -> TCMT IO Doc -> ReduceM ()
forall a b. (a -> b) -> a -> b
$ TCMT IO Doc
" result" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> Term -> TCMT IO Doc
forall (m :: * -> *) a. (Applicative m, Pretty a) => a -> m Doc
pretty Term
v
reduceDefCopyTCM :: QName -> Elims -> TCM (Reduced () Term)
reduceDefCopyTCM :: QName -> Elims -> TCM (Reduced () Term)
reduceDefCopyTCM = QName -> Elims -> TCM (Reduced () Term)
forall (m :: * -> *).
PureTCM m =>
QName -> Elims -> m (Reduced () Term)
reduceDefCopy
reduceDefCopy :: forall m. PureTCM m => QName -> Elims -> m (Reduced () Term)
reduceDefCopy :: forall (m :: * -> *).
PureTCM m =>
QName -> Elims -> m (Reduced () Term)
reduceDefCopy QName
f Elims
es = do
info <- QName -> m Definition
forall (m :: * -> *). HasConstInfo m => QName -> m Definition
getConstInfo QName
f
case theDef info of
Defn
_ | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Definition -> Bool
defCopy Definition
info -> Reduced () Term -> m (Reduced () Term)
forall a. a -> m a
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 ()
Constructor{conSrcCon :: Defn -> ConHead
conSrcCon = ConHead
c} -> Reduced () Term -> m (Reduced () Term)
forall a. a -> m a
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
YesSimplification (ConHead -> ConInfo -> Elims -> Term
Con ConHead
c ConInfo
ConOSystem Elims
es)
Defn
_ -> Definition -> QName -> Elims -> m (Reduced () Term)
reduceDef_ Definition
info QName
f Elims
es
where
reduceDef_ :: Definition -> QName -> Elims -> m (Reduced () Term)
reduceDef_ :: Definition -> QName -> Elims -> m (Reduced () Term)
reduceDef_ Definition
info QName
f Elims
es = case Definition -> [Clause]
defClauses Definition
info of
[Clause
cl] -> do
let v0 :: Term
v0 = QName -> Elims -> Term
Def QName
f []
ps :: NAPs
ps = Clause -> NAPs
namedClausePats Clause
cl
nargs :: Int
nargs = Elims -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Elims
es
(Term -> Term
lam, Elims
es') = ([Arg [Char]] -> Term -> Term
unlamView [Arg [Char]]
xs, Elims
newes)
where
etaArgs :: NAPs -> [a] -> [Arg [Char]]
etaArgs [] [a]
_ = []
etaArgs (NamedArg DeBruijnPattern
p : NAPs
ps) []
| VarP PatternInfo
_ DBPatVar
x <- NamedArg DeBruijnPattern -> DeBruijnPattern
forall a. NamedArg a -> a
namedArg NamedArg DeBruijnPattern
p = ArgInfo -> [Char] -> Arg [Char]
forall e. ArgInfo -> e -> Arg e
Arg (NamedArg DeBruijnPattern -> ArgInfo
forall a. LensArgInfo a => a -> ArgInfo
getArgInfo NamedArg DeBruijnPattern
p) (DBPatVar -> [Char]
dbPatVarName DBPatVar
x) Arg [Char] -> [Arg [Char]] -> [Arg [Char]]
forall a. a -> [a] -> [a]
: NAPs -> [a] -> [Arg [Char]]
etaArgs NAPs
ps []
| Bool
otherwise = []
etaArgs (NamedArg DeBruijnPattern
_ : NAPs
ps) (a
_ : [a]
es) = NAPs -> [a] -> [Arg [Char]]
etaArgs NAPs
ps [a]
es
xs :: [Arg [Char]]
xs = NAPs -> Elims -> [Arg [Char]]
forall {a}. NAPs -> [a] -> [Arg [Char]]
etaArgs NAPs
ps Elims
es
n :: Int
n = [Arg [Char]] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Arg [Char]]
xs
newes :: Elims
newes = Int -> Elims -> Elims
forall a. Subst a => Int -> a -> a
raise Int
n Elims
es Elims -> Elims -> Elims
forall a. [a] -> [a] -> [a]
++ [ Arg Term -> Elim
forall a. Arg a -> Elim' a
Apply (Arg Term -> Elim) -> Arg Term -> Elim
forall a b. (a -> b) -> a -> b
$ Int -> Term
var Int
i Term -> Arg [Char] -> Arg Term
forall a b. a -> Arg b -> Arg a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Arg [Char]
x | (Int
i, Arg [Char]
x) <- [Int] -> [Arg [Char]] -> [(Int, Arg [Char])]
forall a b. [a] -> [b] -> [(a, b)]
zip (Int -> [Int]
forall a. Integral a => a -> [a]
downFrom Int
n) [Arg [Char]]
xs ]
if Definition -> Bool
defNonterminating Definition
info
then Reduced () Term -> m (Reduced () Term)
forall a. a -> m a
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
ev <- ReduceM (Reduced (Blocked' Term Term) Term)
-> m (Reduced (Blocked' Term Term) Term)
forall a. ReduceM a -> m a
forall (m :: * -> *) a. MonadReduce m => ReduceM a -> m a
liftReduce (ReduceM (Reduced (Blocked' Term Term) Term)
-> m (Reduced (Blocked' Term Term) Term))
-> ReduceM (Reduced (Blocked' Term Term) Term)
-> m (Reduced (Blocked' Term Term) Term)
forall a b. (a -> b) -> a -> b
$ QName
-> Term
-> [Clause]
-> Maybe CompiledClauses
-> RewriteRules
-> [MaybeReduced Elim]
-> ReduceM (Reduced (Blocked' Term Term) Term)
appDefE_ QName
f Term
v0 [Clause
cl] Maybe CompiledClauses
forall a. Maybe a
Nothing RewriteRules
forall a. Monoid a => a
mempty ([MaybeReduced Elim]
-> ReduceM (Reduced (Blocked' Term Term) Term))
-> [MaybeReduced Elim]
-> ReduceM (Reduced (Blocked' Term 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 ev of
YesReduction Simplification
simpl Term
t -> Reduced () Term -> m (Reduced () Term)
forall a. a -> m a
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 -> Term
lam Term
t)
NoReduction{} -> Reduced () Term -> m (Reduced () Term)
forall a. a -> m a
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 ()
[] -> Reduced () Term -> m (Reduced () Term)
forall a. a -> m a
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 ()
Clause
_:Clause
_:[Clause]
_ -> m (Reduced () Term)
forall a. HasCallStack => a
__IMPOSSIBLE__
reduceHead :: PureTCM m => Term -> m (Blocked Term)
reduceHead :: forall (m :: * -> *). PureTCM m => Term -> m (Blocked' Term Term)
reduceHead Term
v = do
v <- Term -> m Term
forall (m :: * -> *). HasBuiltins m => Term -> m Term
constructorForm Term
v
traceSDoc "tc.inj.reduce" 30 (ignoreAbstractMode $ "reduceHead" <+> prettyTCM v) $ do
case v of
Def QName
f Elims
es -> do
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
isAbstract <- not <$> hasAccessibleDef f
traceSLn "tc.inj.reduce" 50 (
"reduceHead: we are in " ++ show abstractMode ++ "; " ++ prettyShow f ++
" is treated " ++ if isAbstract then "abstractly" else "concretely"
) $ do
let v0 = QName -> Elims -> Term
Def QName
f []
red = ReduceM (Blocked' Term Term) -> m (Blocked' Term Term)
forall a. ReduceM a -> m a
forall (m :: * -> *) a. MonadReduce m => ReduceM a -> m a
liftReduce (ReduceM (Blocked' Term Term) -> m (Blocked' Term Term))
-> ReduceM (Blocked' Term Term) -> m (Blocked' Term Term)
forall a b. (a -> b) -> a -> b
$ (Term -> ReduceM (Blocked' Term Term))
-> Term -> QName -> Elims -> ReduceM (Blocked' Term Term)
unfoldDefinitionE Term -> ReduceM (Blocked' Term Term)
forall (m :: * -> *). PureTCM m => Term -> m (Blocked' Term Term)
reduceHead Term
v0 QName
f Elims
es
def <- theDef <$> getConstInfo f
case def of
Function{ funClauses :: Defn -> [Clause]
funClauses = [ Clause
_ ], funTerminates :: Defn -> Maybe Bool
funTerminates = Just Bool
True } -> do
[Char]
-> Int
-> [Char]
-> m (Blocked' Term Term)
-> m (Blocked' Term Term)
forall (m :: * -> *) a.
MonadDebug m =>
[Char] -> Int -> [Char] -> m a -> m a
traceSLn [Char]
"tc.inj.reduce" Int
50 ([Char]
"reduceHead: head " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ QName -> [Char]
forall a. Pretty a => a -> [Char]
prettyShow QName
f [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" is Function") (m (Blocked' Term Term) -> m (Blocked' Term Term))
-> m (Blocked' Term Term) -> m (Blocked' Term Term)
forall a b. (a -> b) -> a -> b
$ do
red
Datatype{ dataClause :: Defn -> Maybe Clause
dataClause = Just Clause
_ } -> m (Blocked' Term Term)
red
Record{ recClause :: Defn -> Maybe Clause
recClause = Just Clause
_ } -> m (Blocked' Term Term)
red
Defn
_ -> Blocked' Term Term -> m (Blocked' Term Term)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocked' Term Term -> m (Blocked' Term Term))
-> Blocked' Term Term -> m (Blocked' Term Term)
forall a b. (a -> b) -> a -> b
$ Term -> Blocked' Term Term
forall a t. a -> Blocked' t a
notBlocked Term
v
Term
_ -> Blocked' Term Term -> m (Blocked' Term Term)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocked' Term Term -> m (Blocked' Term Term))
-> Blocked' Term Term -> m (Blocked' Term Term)
forall a b. (a -> b) -> a -> b
$ Term -> Blocked' Term Term
forall a t. a -> Blocked' t a
notBlocked Term
v
unfoldInlined :: PureTCM m => Term -> m Term
unfoldInlined :: forall (m :: * -> *). PureTCM m => Term -> m Term
unfoldInlined Term
v = do
inTypes <- Lens' TCEnv Bool -> m Bool
forall (m :: * -> *) a. MonadTCEnv m => Lens' TCEnv a -> m a
viewTC (Bool -> f Bool) -> TCEnv -> f TCEnv
Lens' TCEnv Bool
eWorkingOnTypes
case v of
Term
_ | Bool
inTypes -> Term -> m Term
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Term
v
Def QName
f Elims
es -> do
info <- QName -> m Definition
forall (m :: * -> *). HasConstInfo m => QName -> m Definition
getConstInfo QName
f
let def = Definition -> Defn
theDef Definition
info
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 def of
Function{} ->
[Char] -> Int -> [Char] -> m ()
forall (m :: * -> *).
MonadDebug m =>
[Char] -> Int -> [Char] -> m ()
reportSLn [Char]
"tc.inline" Int
90 ([Char] -> m ()) -> [Char] -> m ()
forall a b. (a -> b) -> a -> b
$
[Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"\n"
[ [Char]
"considering to inline " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ QName -> [Char]
forall a. Pretty a => a -> [Char]
prettyShow QName
f
, [Char]
"irr = " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Bool -> [Char]
forall a. Pretty a => a -> [Char]
prettyShow Bool
irr
, [Char]
"funInline = " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Bool -> [Char]
forall a. Pretty a => a -> [Char]
prettyShow (Defn
def Defn -> Lens' Defn Bool -> Bool
forall o i. o -> Lens' o i -> i
^. (Bool -> f Bool) -> Defn -> f Defn
Lens' Defn Bool
funInline)
, [Char]
"funCompiled = " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Maybe CompiledClauses -> [Char]
forall a. Pretty a => a -> [Char]
prettyShow (Defn -> Maybe CompiledClauses
funCompiled Defn
def)
]
Defn
_ -> () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
case def of
Function{ funCompiled :: Defn -> Maybe CompiledClauses
funCompiled = Just Done{} }
| Defn
def Defn -> Lens' Defn Bool -> Bool
forall o i. o -> Lens' o i -> i
^. (Bool -> f Bool) -> Defn -> f Defn
Lens' Defn Bool
funInline , Bool -> Bool
not Bool
irr -> do
[Char] -> Int -> [Char] -> m ()
forall (m :: * -> *).
MonadDebug m =>
[Char] -> Int -> [Char] -> m ()
reportSLn [Char]
"tc.inline" Int
70 ([Char] -> m ()) -> [Char] -> m ()
forall a b. (a -> b) -> a -> b
$ [Char]
"asking to inline " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ QName -> [Char]
forall a. Pretty a => a -> [Char]
prettyShow QName
f
ReduceM Term -> m Term
forall a. ReduceM a -> m a
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 -> Term
forall t a. Blocked' t a -> a
ignoreBlocking (Blocked' Term Term -> Term)
-> ReduceM (Blocked' Term Term) -> ReduceM Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Term -> ReduceM (Blocked' Term Term))
-> Term -> QName -> Elims -> ReduceM (Blocked' Term Term)
unfoldDefinitionE (Blocked' Term Term -> ReduceM (Blocked' Term Term)
forall a. a -> ReduceM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocked' Term Term -> ReduceM (Blocked' Term Term))
-> (Term -> Blocked' Term Term)
-> Term
-> ReduceM (Blocked' Term Term)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term -> Blocked' Term Term
forall a t. a -> Blocked' t a
notBlocked) (QName -> Elims -> Term
Def QName
f []) QName
f Elims
es
Defn
_ -> Term -> m Term
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Term
v
Term
_ -> Term -> m Term
forall a. a -> m a
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) Term)
appDef_ QName
f Term
v0 [Clause]
cls Maybe CompiledClauses
mcc RewriteRules
rewr MaybeReducedArgs
args = QName
-> Term
-> [Clause]
-> Maybe CompiledClauses
-> RewriteRules
-> [MaybeReduced Elim]
-> ReduceM (Reduced (Blocked' Term Term) Term)
appDefE_ QName
f Term
v0 [Clause]
cls Maybe CompiledClauses
mcc RewriteRules
rewr ([MaybeReduced Elim]
-> ReduceM (Reduced (Blocked' Term Term) Term))
-> [MaybeReduced Elim]
-> ReduceM (Reduced (Blocked' Term 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 a b. (a -> b) -> MaybeReduced a -> MaybeReduced b
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) Term)
appDefE_ QName
f Term
v0 [Clause]
cls Maybe CompiledClauses
mcc RewriteRules
rewr [MaybeReduced Elim]
args =
(TCEnv -> TCEnv)
-> ReduceM (Reduced (Blocked' Term Term) Term)
-> ReduceM (Reduced (Blocked' Term Term) Term)
forall a. (TCEnv -> TCEnv) -> ReduceM a -> ReduceM a
forall (m :: * -> *) a.
MonadTCEnv m =>
(TCEnv -> TCEnv) -> m a -> m a
localTC (\ TCEnv
e -> TCEnv
e { envAppDef = Just f }) (ReduceM (Reduced (Blocked' Term Term) Term)
-> ReduceM (Reduced (Blocked' Term Term) Term))
-> ReduceM (Reduced (Blocked' Term Term) Term)
-> ReduceM (Reduced (Blocked' Term Term) Term)
forall a b. (a -> b) -> a -> b
$
ReduceM (Reduced (Blocked' Term Term) Term)
-> (CompiledClauses -> ReduceM (Reduced (Blocked' Term Term) Term))
-> Maybe CompiledClauses
-> ReduceM (Reduced (Blocked' Term Term) Term)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Term
-> [Clause]
-> RewriteRules
-> [MaybeReduced Elim]
-> ReduceM (Reduced (Blocked' Term Term) Term)
appDefE'' Term
v0 [Clause]
cls RewriteRules
rewr [MaybeReduced Elim]
args)
(\CompiledClauses
cc -> Term
-> CompiledClauses
-> RewriteRules
-> [MaybeReduced Elim]
-> ReduceM (Reduced (Blocked' Term 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) Term)
appDef Term
v CompiledClauses
cc RewriteRules
rewr MaybeReducedArgs
args = Term
-> CompiledClauses
-> RewriteRules
-> [MaybeReduced Elim]
-> ReduceM (Reduced (Blocked' Term Term) Term)
appDefE Term
v CompiledClauses
cc RewriteRules
rewr ([MaybeReduced Elim]
-> ReduceM (Reduced (Blocked' Term Term) Term))
-> [MaybeReduced Elim]
-> ReduceM (Reduced (Blocked' Term 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 a b. (a -> b) -> MaybeReduced a -> MaybeReduced b
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) Term)
appDefE Term
v CompiledClauses
cc RewriteRules
rewr [MaybeReduced Elim]
es = do
[Char]
-> Int
-> TCMT IO Doc
-> ReduceM (Reduced (Blocked' Term Term) Term)
-> ReduceM (Reduced (Blocked' Term Term) Term)
forall (m :: * -> *) a.
MonadDebug m =>
[Char] -> Int -> TCMT IO Doc -> m a -> m a
traceSDoc [Char]
"tc.reduce" Int
90 (TCMT IO Doc
"appDefE v = " TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> Term -> TCMT IO Doc
forall (m :: * -> *) a. (Applicative m, Pretty a) => a -> m Doc
pretty Term
v) (ReduceM (Reduced (Blocked' Term Term) Term)
-> ReduceM (Reduced (Blocked' Term Term) Term))
-> ReduceM (Reduced (Blocked' Term Term) Term)
-> ReduceM (Reduced (Blocked' Term Term) Term)
forall a b. (a -> b) -> a -> b
$ do
r <- CompiledClauses
-> [MaybeReduced Elim]
-> ReduceM (Reduced (Blocked' Term Elims) Term)
matchCompiledE CompiledClauses
cc [MaybeReduced Elim]
es
case r of
YesReduction Simplification
simpl Term
t -> Reduced (Blocked' Term Term) Term
-> ReduceM (Reduced (Blocked' Term Term) Term)
forall a. a -> ReduceM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Reduced (Blocked' Term Term) Term
-> ReduceM (Reduced (Blocked' Term Term) Term))
-> Reduced (Blocked' Term Term) Term
-> ReduceM (Reduced (Blocked' Term Term) Term)
forall a b. (a -> b) -> a -> b
$ Simplification -> Term -> Reduced (Blocked' Term Term) Term
forall no yes. Simplification -> yes -> Reduced no yes
YesReduction Simplification
simpl Term
t
NoReduction Blocked' Term Elims
es' -> Blocked' Term ()
-> (Elims -> Term)
-> RewriteRules
-> Elims
-> ReduceM (Reduced (Blocked' Term Term) Term)
rewrite (Blocked' Term Elims -> Blocked' Term ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Blocked' Term Elims
es') (Term -> Elims -> Term
forall t. Apply t => t -> Elims -> t
applyE Term
v) RewriteRules
rewr (Blocked' Term Elims -> Elims
forall t a. Blocked' t a -> a
ignoreBlocking Blocked' Term Elims
es')
appDef' :: QName -> Term -> [Clause] -> RewriteRules -> MaybeReducedArgs -> ReduceM (Reduced (Blocked Term) Term)
appDef' :: QName
-> Term
-> [Clause]
-> RewriteRules
-> MaybeReducedArgs
-> ReduceM (Reduced (Blocked' Term Term) Term)
appDef' QName
f Term
v [Clause]
cls RewriteRules
rewr MaybeReducedArgs
args = QName
-> Term
-> [Clause]
-> RewriteRules
-> [MaybeReduced Elim]
-> ReduceM (Reduced (Blocked' Term Term) Term)
appDefE' QName
f Term
v [Clause]
cls RewriteRules
rewr ([MaybeReduced Elim]
-> ReduceM (Reduced (Blocked' Term Term) Term))
-> [MaybeReduced Elim]
-> ReduceM (Reduced (Blocked' Term 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 a b. (a -> b) -> MaybeReduced a -> MaybeReduced b
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] -> RewriteRules -> MaybeReducedElims -> ReduceM (Reduced (Blocked Term) Term)
appDefE' :: QName
-> Term
-> [Clause]
-> RewriteRules
-> [MaybeReduced Elim]
-> ReduceM (Reduced (Blocked' Term Term) Term)
appDefE' QName
f Term
v [Clause]
cls RewriteRules
rewr [MaybeReduced Elim]
es =
(TCEnv -> TCEnv)
-> ReduceM (Reduced (Blocked' Term Term) Term)
-> ReduceM (Reduced (Blocked' Term Term) Term)
forall a. (TCEnv -> TCEnv) -> ReduceM a -> ReduceM a
forall (m :: * -> *) a.
MonadTCEnv m =>
(TCEnv -> TCEnv) -> m a -> m a
localTC (\ TCEnv
e -> TCEnv
e { envAppDef = Just f }) (ReduceM (Reduced (Blocked' Term Term) Term)
-> ReduceM (Reduced (Blocked' Term Term) Term))
-> ReduceM (Reduced (Blocked' Term Term) Term)
-> ReduceM (Reduced (Blocked' Term Term) Term)
forall a b. (a -> b) -> a -> b
$
Term
-> [Clause]
-> RewriteRules
-> [MaybeReduced Elim]
-> ReduceM (Reduced (Blocked' Term Term) Term)
appDefE'' Term
v [Clause]
cls RewriteRules
rewr [MaybeReduced Elim]
es
appDefE'' :: Term -> [Clause] -> RewriteRules -> MaybeReducedElims -> ReduceM (Reduced (Blocked Term) Term)
appDefE'' :: Term
-> [Clause]
-> RewriteRules
-> [MaybeReduced Elim]
-> ReduceM (Reduced (Blocked' Term Term) Term)
appDefE'' Term
v [Clause]
cls RewriteRules
rewr [MaybeReduced Elim]
es = [Char]
-> Int
-> TCMT IO Doc
-> ReduceM (Reduced (Blocked' Term Term) Term)
-> ReduceM (Reduced (Blocked' Term Term) Term)
forall (m :: * -> *) a.
MonadDebug m =>
[Char] -> Int -> TCMT IO Doc -> m a -> m a
traceSDoc [Char]
"tc.reduce" Int
90 (TCMT IO Doc
"appDefE' v = " TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> Term -> TCMT IO Doc
forall (m :: * -> *) a. (Applicative m, Pretty a) => a -> m Doc
pretty Term
v) (ReduceM (Reduced (Blocked' Term Term) Term)
-> ReduceM (Reduced (Blocked' Term Term) Term))
-> ReduceM (Reduced (Blocked' Term Term) Term)
-> ReduceM (Reduced (Blocked' Term Term) Term)
forall a b. (a -> b) -> a -> b
$ do
[Clause] -> Elims -> ReduceM (Reduced (Blocked' Term Term) Term)
goCls [Clause]
cls (Elims -> ReduceM (Reduced (Blocked' Term Term) Term))
-> Elims -> ReduceM (Reduced (Blocked' Term 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) Term)
goCls [Clause]
cl Elims
es = do
case [Clause]
cl of
[] -> do
f <- QName -> Maybe QName -> QName
forall a. a -> Maybe a -> a
fromMaybe QName
forall a. HasCallStack => a
__IMPOSSIBLE__ (Maybe QName -> QName) -> ReduceM (Maybe QName) -> ReduceM QName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (TCEnv -> Maybe QName) -> ReduceM (Maybe QName)
forall (m :: * -> *) a. MonadTCEnv m => (TCEnv -> a) -> m a
asksTC TCEnv -> Maybe QName
envAppDef
rewrite (NotBlocked (MissingClauses f) ()) (applyE v) rewr es
Clause
cl : [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 a. [a] -> 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 a. [a] -> 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) Term)
goCls [Clause]
cls Elims
es else do
let (Elims
es0, Elims
es1) = Int -> Elims -> (Elims, Elims)
forall a. Int -> [a] -> ([a], [a])
splitAt Int
npats Elims
es
(m, es0) <- NAPs -> Elims -> ReduceM (Match Term, Elims)
forall (m :: * -> *).
MonadMatch m =>
NAPs -> Elims -> m (Match Term, Elims)
matchCopatterns NAPs
pats Elims
es0
let es = Elims
es0 Elims -> Elims -> Elims
forall a. [a] -> [a] -> [a]
++ Elims
es1
case m of
Match Term
No -> [Clause] -> Elims -> ReduceM (Reduced (Blocked' Term Term) Term)
goCls [Clause]
cls Elims
es
DontKnow OnlyLazy
OnlyLazy Blocked' Term ()
_ -> [Clause] -> Elims -> ReduceM (Reduced (Blocked' Term Term) Term)
goCls [Clause]
cls Elims
es
DontKnow OnlyLazy
NonLazy Blocked' Term ()
b -> Blocked' Term ()
-> (Elims -> Term)
-> RewriteRules
-> Elims
-> ReduceM (Reduced (Blocked' Term Term) Term)
rewrite Blocked' Term ()
b (Term -> Elims -> Term
forall t. Apply t => t -> Elims -> t
applyE Term
v) RewriteRules
rewr Elims
es
Yes Simplification
simpl IntMap (Arg Term)
vs
| Just Term
w <- Maybe Term
body -> do
let sigma :: Substitution' Term
sigma = Impossible -> Int -> IntMap (Arg Term) -> Substitution' Term
forall a.
DeBruijn a =>
Impossible -> Int -> IntMap (Arg a) -> Substitution' a
buildSubstitution Impossible
HasCallStack => Impossible
impossible Int
nvars IntMap (Arg Term)
vs
Reduced (Blocked' Term Term) Term
-> ReduceM (Reduced (Blocked' Term Term) Term)
forall a. a -> ReduceM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Reduced (Blocked' Term Term) Term
-> ReduceM (Reduced (Blocked' Term Term) Term))
-> Reduced (Blocked' Term Term) Term
-> ReduceM (Reduced (Blocked' Term Term) Term)
forall a b. (a -> b) -> a -> b
$ Simplification -> Term -> Reduced (Blocked' Term Term) Term
forall no yes. Simplification -> yes -> Reduced no yes
YesReduction Simplification
simpl (Term -> Reduced (Blocked' Term Term) Term)
-> Term -> Reduced (Blocked' Term Term) Term
forall a b. (a -> b) -> a -> b
$ Substitution' (SubstArg Term) -> Term -> Term
forall a. Subst a => Substitution' (SubstArg a) -> a -> a
applySubst Substitution' Term
Substitution' (SubstArg Term)
sigma Term
w Term -> Elims -> Term
forall t. Apply t => t -> Elims -> t
`applyE` Elims
es1
| Bool
otherwise -> Blocked' Term ()
-> (Elims -> Term)
-> RewriteRules
-> Elims
-> ReduceM (Reduced (Blocked' Term Term) Term)
rewrite (NotBlocked -> () -> Blocked' Term ()
forall t a. NotBlocked' t -> a -> Blocked' t a
NotBlocked NotBlocked
forall t. NotBlocked' t
AbsurdMatch ()) (Term -> Elims -> Term
forall t. Apply t => t -> Elims -> t
applyE Term
v) RewriteRules
rewr Elims
es
instance Reduce a => Reduce (Closure a) where
reduce' :: Closure a -> ReduceM (Closure a)
reduce' Closure a
cl = do
x <- Closure a -> (a -> ReduceM a) -> ReduceM a
forall c a b. LensClosure c a => c -> (a -> ReduceM b) -> ReduceM b
enterClosure Closure a
cl a -> ReduceM a
forall t. Reduce t => t -> ReduceM t
reduce'
return $ cl { clValue = x }
{-# SPECIALIZE reduce' :: Closure Constraint -> ReduceM (Closure Constraint) #-}
instance Reduce Telescope where
reduce' :: Telescope -> ReduceM Telescope
reduce' Telescope
EmptyTel = Telescope -> ReduceM Telescope
forall a. a -> ReduceM a
forall (m :: * -> *) a. Monad m => a -> m a
return Telescope
forall a. Tele a
EmptyTel
reduce' (ExtendTel Dom Type
a 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 a b. ReduceM (a -> b) -> ReduceM a -> ReduceM b
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 Comparison
cmp CompareAs
t Term
u Term
v) = do
(t,u,v) <- (CompareAs, Term, Term) -> ReduceM (CompareAs, Term, Term)
forall t. Reduce t => t -> ReduceM t
reduce' (CompareAs
t,Term
u,Term
v)
return $ ValueCmp cmp t u v
reduce' (ValueCmpOnFace Comparison
cmp Term
p Type
t Term
u Term
v) = do
((p,t),u,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)
return $ ValueCmpOnFace cmp p t u v
reduce' (ElimCmp [Polarity]
cmp [IsForced]
fs Type
t Term
v Elims
as 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 a b. ReduceM (a -> b) -> ReduceM a -> ReduceM b
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 a b. ReduceM (a -> b) -> ReduceM a -> ReduceM b
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 a b. ReduceM (a -> b) -> ReduceM a -> ReduceM b
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 Comparison
cmp Level
u 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' (SortCmp Comparison
cmp Sort
a 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' (UnBlock MetaId
m) = Constraint -> ReduceM Constraint
forall a. a -> ReduceM a
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 MetaId
m Maybe [Candidate]
cs) = MetaId -> Maybe [Candidate] -> Constraint
FindInstance MetaId
m (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)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Maybe a -> m (Maybe b)
mapM [Candidate] -> ReduceM [Candidate]
forall t. Reduce t => t -> ReduceM t
reduce' Maybe [Candidate]
cs
reduce' (ResolveInstanceHead QName
q) = Constraint -> ReduceM Constraint
forall a. a -> ReduceM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Constraint -> ReduceM Constraint)
-> Constraint -> ReduceM Constraint
forall a b. (a -> b) -> a -> b
$ QName -> Constraint
ResolveInstanceHead QName
q
reduce' (IsEmpty Range
r 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 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 a. a -> ReduceM a
forall (m :: * -> *) a. Monad m => a -> m a
return Constraint
c
reduce' (HasBiggerSort 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 Dom Type
a 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 Term
t Term
h Type
g) = Term -> Term -> Type -> Constraint
UnquoteTactic (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 a b. ReduceM (a -> b) -> ReduceM a -> ReduceM b
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 a b. ReduceM (a -> b) -> ReduceM a -> ReduceM b
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' (CheckLockedVars Term
a Type
b Arg Term
c Type
d) =
Term -> Type -> Arg Term -> Type -> Constraint
CheckLockedVars (Term -> Type -> Arg Term -> Type -> Constraint)
-> ReduceM Term -> ReduceM (Type -> Arg 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
a ReduceM (Type -> Arg Term -> Type -> Constraint)
-> ReduceM Type -> ReduceM (Arg Term -> Type -> Constraint)
forall a b. ReduceM (a -> b) -> ReduceM a -> ReduceM b
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
b ReduceM (Arg Term -> Type -> Constraint)
-> ReduceM (Arg Term) -> ReduceM (Type -> Constraint)
forall a b. ReduceM (a -> b) -> ReduceM a -> ReduceM b
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
c ReduceM (Type -> Constraint) -> ReduceM Type -> ReduceM Constraint
forall a b. ReduceM (a -> b) -> ReduceM a -> ReduceM b
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
d
reduce' (CheckDataSort QName
q Sort
s) = QName -> Sort -> Constraint
CheckDataSort QName
q (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
s
reduce' c :: Constraint
c@CheckMetaInst{} = Constraint -> ReduceM Constraint
forall a. a -> ReduceM a
forall (m :: * -> *) a. Monad m => a -> m a
return Constraint
c
reduce' (CheckType Type
t) = Type -> Constraint
CheckType (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' (UsableAtModality WhyCheckModality
cc Maybe Sort
ms Modality
mod Term
t) = (Maybe Sort -> Modality -> Term -> Constraint)
-> Modality -> Maybe Sort -> Term -> Constraint
forall a b c. (a -> b -> c) -> b -> a -> c
flip (WhyCheckModality -> Maybe Sort -> Modality -> Term -> Constraint
UsableAtModality WhyCheckModality
cc) Modality
mod (Maybe Sort -> Term -> Constraint)
-> ReduceM (Maybe Sort) -> ReduceM (Term -> Constraint)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Sort -> ReduceM (Maybe Sort)
forall t. Reduce t => t -> ReduceM t
reduce' Maybe Sort
ms ReduceM (Term -> Constraint) -> ReduceM Term -> ReduceM Constraint
forall a b. ReduceM (a -> b) -> ReduceM a -> ReduceM b
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
t
instance Reduce CompareAs where
reduce' :: CompareAs -> ReduceM CompareAs
reduce' (AsTermsOf 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' CompareAs
AsSizes = CompareAs -> ReduceM CompareAs
forall a. a -> ReduceM a
forall (m :: * -> *) a. Monad m => a -> m a
return CompareAs
AsSizes
reduce' CompareAs
AsTypes = CompareAs -> ReduceM CompareAs
forall a. a -> ReduceM a
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)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Map k a -> f (Map k b)
traverse e -> ReduceM e
forall t. Reduce t => t -> ReduceM t
reduce'
instance Reduce Candidate where
reduce' :: Candidate -> ReduceM Candidate
reduce' (Candidate CandidateKind
q Term
u Type
t OverlapMode
ov) = CandidateKind -> Term -> Type -> OverlapMode -> Candidate
Candidate CandidateKind
q (Term -> Type -> OverlapMode -> Candidate)
-> ReduceM Term -> ReduceM (Type -> OverlapMode -> 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 -> OverlapMode -> Candidate)
-> ReduceM Type -> ReduceM (OverlapMode -> Candidate)
forall a b. ReduceM (a -> b) -> ReduceM a -> ReduceM b
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 (OverlapMode -> Candidate)
-> ReduceM OverlapMode -> ReduceM Candidate
forall a b. ReduceM (a -> b) -> ReduceM a -> ReduceM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> OverlapMode -> ReduceM OverlapMode
forall a. a -> ReduceM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure OverlapMode
ov
instance Reduce EqualityView where
reduce' :: EqualityView -> ReduceM EqualityView
reduce' (OtherType 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' (IdiomType Type
t) = Type -> EqualityView
IdiomType
(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 Sort
s QName
eq [Arg Term]
l Arg Term
t Arg Term
a 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 a b. ReduceM (a -> b) -> ReduceM a -> ReduceM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> QName -> ReduceM QName
forall a. a -> ReduceM a
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 a b. ReduceM (a -> b) -> ReduceM a -> ReduceM b
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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [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 a b. ReduceM (a -> b) -> ReduceM a -> ReduceM b
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 a b. ReduceM (a -> b) -> ReduceM a -> ReduceM b
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 a b. ReduceM (a -> b) -> ReduceM a -> ReduceM b
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)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> IPBoundary' a -> f (IPBoundary' b)
traverse t -> ReduceM t
forall t. Reduce t => t -> ReduceM t
reduce'
reduceB' :: IPBoundary' t -> ReduceM (Blocked (IPBoundary' t))
reduceB' = (IPBoundary' (Blocked' Term t) -> Blocked (IPBoundary' t))
-> ReduceM (IPBoundary' (Blocked' Term t))
-> ReduceM (Blocked (IPBoundary' t))
forall a b. (a -> b) -> ReduceM a -> ReduceM b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap IPBoundary' (Blocked' Term t) -> Blocked (IPBoundary' t)
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a.
Applicative f =>
IPBoundary' (f a) -> f (IPBoundary' a)
sequenceA (ReduceM (IPBoundary' (Blocked' Term t))
-> ReduceM (Blocked (IPBoundary' t)))
-> (IPBoundary' t -> ReduceM (IPBoundary' (Blocked' Term t)))
-> IPBoundary' t
-> ReduceM (Blocked (IPBoundary' t))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (t -> ReduceM (Blocked' Term t))
-> IPBoundary' t -> ReduceM (IPBoundary' (Blocked' Term t))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> IPBoundary' a -> f (IPBoundary' b)
traverse t -> ReduceM (Blocked' Term 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)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> f a -> f (f 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' (a
x,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 a b. ReduceM (a -> b) -> ReduceM a -> ReduceM 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' (a
x,b
y,c
z) =
do (x,(y,z)) <- (a, (b, c)) -> ReduceM (a, (b, c))
forall t. Simplify t => t -> ReduceM t
simplify' (a
x,(b
y,c
z))
return (x,y,z)
instance Simplify Bool where
simplify' :: Bool -> ReduceM Bool
simplify' = Bool -> ReduceM Bool
forall a. a -> ReduceM a
forall (m :: * -> *) a. Monad m => a -> m a
return
instance Simplify Term where
simplify' :: Term -> ReduceM Term
simplify' Term
v = do
v <- Term -> ReduceM Term
forall t. Instantiate t => t -> ReduceM t
instantiate' Term
v
let iapp Elims
es ReduceM Term
m = Blocked' Term Term -> Term
forall t a. Blocked' t a -> a
ignoreBlocking (Blocked' Term Term -> Term)
-> ReduceM (Blocked' Term Term) -> ReduceM Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Term -> ReduceM (Blocked' Term Term))
-> ReduceM (Blocked' Term Term)
-> Elims
-> ReduceM (Blocked' Term Term)
reduceIApply' ((Term -> Blocked' Term Term)
-> ReduceM Term -> ReduceM (Blocked' Term Term)
forall a b. (a -> b) -> ReduceM a -> ReduceM b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Term -> Blocked' Term Term
forall a t. a -> Blocked' t a
notBlocked (ReduceM Term -> ReduceM (Blocked' Term Term))
-> (Term -> ReduceM Term) -> Term -> ReduceM (Blocked' Term Term)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term -> ReduceM Term
forall t. Simplify t => t -> ReduceM t
simplify') (Term -> Blocked' Term Term
forall a t. a -> Blocked' t a
notBlocked (Term -> Blocked' Term Term)
-> ReduceM Term -> ReduceM (Blocked' Term Term)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReduceM Term
m) Elims
es
case v of
Def QName
f Elims
vs -> Elims -> ReduceM Term -> ReduceM Term
iapp Elims
vs (ReduceM Term -> ReduceM Term) -> ReduceM Term -> ReduceM Term
forall a b. (a -> b) -> a -> b
$ do
let keepGoing :: a -> a -> m (a, Blocked' t a)
keepGoing a
simp a
v = (a, Blocked' t a) -> m (a, Blocked' t a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a
simp, a -> Blocked' t a
forall a t. a -> Blocked' t a
notBlocked a
v)
(simpl, v) <- (Simplification
-> Term -> ReduceM (Simplification, Blocked' Term Term))
-> Term
-> QName
-> Elims
-> ReduceM (Simplification, Blocked' Term Term)
unfoldDefinition' Simplification
-> Term -> ReduceM (Simplification, Blocked' Term Term)
forall {m :: * -> *} {a} {a} {t}.
Monad m =>
a -> a -> m (a, Blocked' t a)
keepGoing (QName -> Elims -> Term
Def QName
f []) QName
f Elims
vs
when (simpl == YesSimplification) $
reportSDoc "tc.simplify'" 90 $
pretty f <+> text ("simplify': unfolding definition returns " ++ show simpl) <+> pretty (ignoreBlocking v)
case simpl of
Simplification
YesSimplification -> Blocked' Term Term -> ReduceM Term
forall t. Simplify t => Blocked t -> ReduceM t
simplifyBlocked' Blocked' Term Term
v
Simplification
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 MetaId
x Elims
vs -> Elims -> ReduceM Term -> ReduceM Term
iapp Elims
vs (ReduceM Term -> ReduceM Term) -> ReduceM Term -> ReduceM Term
forall a b. (a -> b) -> a -> b
$ 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 ConHead
c ConInfo
ci Elims
vs-> Elims -> ReduceM Term -> ReduceM Term
iapp Elims
vs (ReduceM Term -> ReduceM Term) -> ReduceM Term -> ReduceM Term
forall a b. (a -> b) -> a -> b
$ 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 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 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 Dom Type
a 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 a b. ReduceM (a -> b) -> ReduceM a -> ReduceM b
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 Literal
l -> Term -> ReduceM Term
forall a. a -> ReduceM a
forall (m :: * -> *) a. Monad m => a -> m a
return Term
v
Var Int
i Elims
vs -> Elims -> ReduceM Term -> ReduceM Term
iapp Elims
vs (ReduceM Term -> ReduceM Term) -> ReduceM Term -> ReduceM Term
forall a b. (a -> b) -> a -> b
$ 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 ArgInfo
h 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 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 a. a -> ReduceM a
forall (m :: * -> *) a. Monad m => a -> m a
return Term
v
simplifyBlocked' :: Simplify t => Blocked t -> ReduceM t
simplifyBlocked' :: forall t. Simplify t => Blocked t -> ReduceM t
simplifyBlocked' (Blocked Blocker
_ t
t) = t -> ReduceM t
forall a. a -> ReduceM a
forall (m :: * -> *) a. Monad m => a -> m a
return t
t
simplifyBlocked' (NotBlocked NotBlocked
_ 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 Sort
s 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 a b. ReduceM (a -> b) -> ReduceM a -> ReduceM b
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' Sort
s = do
case Sort
s of
PiSort Dom' Term Term
a Sort
s1 Abs Sort
s2 -> Dom' Term Term -> Sort -> Abs Sort -> Sort
piSort (Dom' Term Term -> Sort -> Abs Sort -> Sort)
-> ReduceM (Dom' Term Term) -> ReduceM (Sort -> Abs Sort -> Sort)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Dom' Term Term -> ReduceM (Dom' Term Term)
forall t. Simplify t => t -> ReduceM t
simplify' Dom' Term Term
a ReduceM (Sort -> Abs Sort -> Sort)
-> ReduceM Sort -> ReduceM (Abs Sort -> Sort)
forall a b. ReduceM (a -> b) -> ReduceM a -> ReduceM b
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
s1 ReduceM (Abs Sort -> Sort) -> ReduceM (Abs Sort) -> ReduceM Sort
forall a b. ReduceM (a -> b) -> ReduceM a -> ReduceM b
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
s2
FunSort Sort
s1 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 a b. ReduceM (a -> b) -> ReduceM a -> ReduceM b
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 Sort
s -> Sort -> Sort
univSort (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
Univ Univ
u Level
s -> Univ -> Level -> Sort
forall t. Univ -> Level' t -> Sort' t
Univ Univ
u (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 Univ
_ Integer
_ -> Sort -> ReduceM Sort
forall a. a -> ReduceM a
forall (m :: * -> *) a. Monad m => a -> m a
return Sort
s
Sort
SizeUniv -> Sort -> ReduceM Sort
forall a. a -> ReduceM a
forall (m :: * -> *) a. Monad m => a -> m a
return Sort
s
Sort
LockUniv -> Sort -> ReduceM Sort
forall a. a -> ReduceM a
forall (m :: * -> *) a. Monad m => a -> m a
return Sort
s
Sort
LevelUniv -> Sort -> ReduceM Sort
forall a. a -> ReduceM a
forall (m :: * -> *) a. Monad m => a -> m a
return Sort
s
Sort
IntervalUniv -> Sort -> ReduceM Sort
forall a. a -> ReduceM a
forall (m :: * -> *) a. Monad m => a -> m a
return Sort
s
MetaS MetaId
x 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 QName
d 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 a. a -> ReduceM a
forall (m :: * -> *) a. Monad m => a -> m a
return Sort
s
instance Simplify Level where
simplify' :: Level -> ReduceM Level
simplify' (Max Integer
m [PlusLevel]
as) = Integer -> [PlusLevel] -> Level
levelMax Integer
m ([PlusLevel] -> Level) -> ReduceM [PlusLevel] -> ReduceM Level
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [PlusLevel] -> ReduceM [PlusLevel]
forall t. Simplify t => t -> ReduceM t
simplify' [PlusLevel]
as
instance Simplify PlusLevel where
simplify' :: PlusLevel -> ReduceM PlusLevel
simplify' (Plus Integer
n Term
l) = Integer -> Term -> PlusLevel
forall t. Integer -> t -> PlusLevel' t
Plus Integer
n (Term -> PlusLevel) -> ReduceM Term -> ReduceM PlusLevel
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term -> ReduceM Term
forall t. Simplify t => t -> ReduceM t
simplify' Term
l
instance (Subst a, Simplify a) => Simplify (Abs a) where
simplify' :: Abs a -> ReduceM (Abs a)
simplify' a :: Abs a
a@(Abs [Char]
x a
_) = [Char] -> a -> Abs a
forall a. [Char] -> a -> Abs a
Abs [Char]
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 a (m :: * -> *) b.
(Subst 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 [Char]
x a
v) = [Char] -> a -> Abs a
forall a. [Char] -> a -> Abs a
NoAbs [Char]
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)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Dom' Term a -> f (Dom' Term 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' Closure a
cl = do
x <- Closure a -> (a -> ReduceM a) -> ReduceM a
forall c a b. LensClosure c a => c -> (a -> ReduceM b) -> ReduceM b
enterClosure Closure a
cl a -> ReduceM a
forall t. Simplify t => t -> ReduceM t
simplify'
return $ cl { clValue = x }
instance (Subst a, Simplify a) => Simplify (Tele a) where
simplify' :: Tele a -> ReduceM (Tele a)
simplify' Tele a
EmptyTel = Tele a -> ReduceM (Tele a)
forall a. a -> ReduceM a
forall (m :: * -> *) a. Monad m => a -> m a
return Tele a
forall a. Tele a
EmptyTel
simplify' (ExtendTel a
a 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 Set ProblemId
pid Blocker
unblock Closure Constraint
c) = Set ProblemId -> Blocker -> Closure Constraint -> ProblemConstraint
PConstr Set ProblemId
pid Blocker
unblock (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 Comparison
cmp CompareAs
t Term
u Term
v) = do
(t,u,v) <- (CompareAs, Term, Term) -> ReduceM (CompareAs, Term, Term)
forall t. Simplify t => t -> ReduceM t
simplify' (CompareAs
t,Term
u,Term
v)
return $ ValueCmp cmp t u v
simplify' (ValueCmpOnFace Comparison
cmp Term
p Type
t Term
u Term
v) = do
((p,t),u,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)
return $ ValueCmp cmp (AsTermsOf t) u v
simplify' (ElimCmp [Polarity]
cmp [IsForced]
fs Type
t Term
v Elims
as 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 a b. ReduceM (a -> b) -> ReduceM a -> ReduceM b
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 a b. ReduceM (a -> b) -> ReduceM a -> ReduceM b
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 a b. ReduceM (a -> b) -> ReduceM a -> ReduceM b
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 Comparison
cmp Level
u 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' (SortCmp Comparison
cmp Sort
a 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' (UnBlock MetaId
m) = Constraint -> ReduceM Constraint
forall a. a -> ReduceM a
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 MetaId
m Maybe [Candidate]
cs) = MetaId -> Maybe [Candidate] -> Constraint
FindInstance MetaId
m (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)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Maybe a -> m (Maybe b)
mapM [Candidate] -> ReduceM [Candidate]
forall t. Simplify t => t -> ReduceM t
simplify' Maybe [Candidate]
cs
simplify' (ResolveInstanceHead QName
q) = Constraint -> ReduceM Constraint
forall a. a -> ReduceM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Constraint -> ReduceM Constraint)
-> Constraint -> ReduceM Constraint
forall a b. (a -> b) -> a -> b
$ QName -> Constraint
ResolveInstanceHead QName
q
simplify' (IsEmpty Range
r 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 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 a. a -> ReduceM a
forall (m :: * -> *) a. Monad m => a -> m a
return Constraint
c
simplify' (HasBiggerSort 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 Dom Type
a 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 Term
t Term
h Type
g) = Term -> Term -> Type -> Constraint
UnquoteTactic (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 a b. ReduceM (a -> b) -> ReduceM a -> ReduceM b
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 a b. ReduceM (a -> b) -> ReduceM a -> ReduceM b
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' (CheckLockedVars Term
a Type
b Arg Term
c Type
d) =
Term -> Type -> Arg Term -> Type -> Constraint
CheckLockedVars (Term -> Type -> Arg Term -> Type -> Constraint)
-> ReduceM Term -> ReduceM (Type -> Arg 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
a ReduceM (Type -> Arg Term -> Type -> Constraint)
-> ReduceM Type -> ReduceM (Arg Term -> Type -> Constraint)
forall a b. ReduceM (a -> b) -> ReduceM a -> ReduceM b
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
b ReduceM (Arg Term -> Type -> Constraint)
-> ReduceM (Arg Term) -> ReduceM (Type -> Constraint)
forall a b. ReduceM (a -> b) -> ReduceM a -> ReduceM b
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
c ReduceM (Type -> Constraint) -> ReduceM Type -> ReduceM Constraint
forall a b. ReduceM (a -> b) -> ReduceM a -> ReduceM b
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
d
simplify' (CheckDataSort QName
q Sort
s) = QName -> Sort -> Constraint
CheckDataSort QName
q (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
s
simplify' c :: Constraint
c@CheckMetaInst{} = Constraint -> ReduceM Constraint
forall a. a -> ReduceM a
forall (m :: * -> *) a. Monad m => a -> m a
return Constraint
c
simplify' (CheckType Type
t) = Type -> Constraint
CheckType (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' (UsableAtModality WhyCheckModality
cc Maybe Sort
ms Modality
mod Term
t) = (Maybe Sort -> Modality -> Term -> Constraint)
-> Modality -> Maybe Sort -> Term -> Constraint
forall a b c. (a -> b -> c) -> b -> a -> c
flip (WhyCheckModality -> Maybe Sort -> Modality -> Term -> Constraint
UsableAtModality WhyCheckModality
cc) Modality
mod (Maybe Sort -> Term -> Constraint)
-> ReduceM (Maybe Sort) -> ReduceM (Term -> Constraint)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Sort -> ReduceM (Maybe Sort)
forall t. Simplify t => t -> ReduceM t
simplify' Maybe Sort
ms ReduceM (Term -> Constraint) -> ReduceM Term -> ReduceM Constraint
forall a b. ReduceM (a -> b) -> ReduceM a -> ReduceM b
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
t
instance Simplify CompareAs where
simplify' :: CompareAs -> ReduceM CompareAs
simplify' (AsTermsOf 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' CompareAs
AsSizes = CompareAs -> ReduceM CompareAs
forall a. a -> ReduceM a
forall (m :: * -> *) a. Monad m => a -> m a
return CompareAs
AsSizes
simplify' CompareAs
AsTypes = CompareAs -> ReduceM CompareAs
forall a. a -> ReduceM a
forall (m :: * -> *) a. Monad m => a -> m a
return CompareAs
AsTypes
instance Simplify DisplayForm where
simplify' :: DisplayForm -> ReduceM DisplayForm
simplify' (Display Int
n Elims
ps 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 a b. ReduceM (a -> b) -> ReduceM a -> ReduceM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> DisplayTerm -> ReduceM DisplayTerm
forall a. a -> ReduceM a
forall (m :: * -> *) a. Monad m => a -> m a
return DisplayTerm
v
instance Simplify Candidate where
simplify' :: Candidate -> ReduceM Candidate
simplify' (Candidate CandidateKind
q Term
u Type
t OverlapMode
ov) = CandidateKind -> Term -> Type -> OverlapMode -> Candidate
Candidate CandidateKind
q (Term -> Type -> OverlapMode -> Candidate)
-> ReduceM Term -> ReduceM (Type -> OverlapMode -> 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 -> OverlapMode -> Candidate)
-> ReduceM Type -> ReduceM (OverlapMode -> Candidate)
forall a b. ReduceM (a -> b) -> ReduceM a -> ReduceM b
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 (OverlapMode -> Candidate)
-> ReduceM OverlapMode -> ReduceM Candidate
forall a b. ReduceM (a -> b) -> ReduceM a -> ReduceM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> OverlapMode -> ReduceM OverlapMode
forall a. a -> ReduceM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure OverlapMode
ov
instance Simplify EqualityView where
simplify' :: EqualityView -> ReduceM EqualityView
simplify' (OtherType 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' (IdiomType Type
t) = Type -> EqualityView
IdiomType
(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 Sort
s QName
eq [Arg Term]
l Arg Term
t Arg Term
a 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 a b. ReduceM (a -> b) -> ReduceM a -> ReduceM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> QName -> ReduceM QName
forall a. a -> ReduceM a
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 a b. ReduceM (a -> b) -> ReduceM a -> ReduceM b
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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [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 a b. ReduceM (a -> b) -> ReduceM a -> ReduceM b
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 a b. ReduceM (a -> b) -> ReduceM a -> ReduceM b
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 a b. ReduceM (a -> b) -> ReduceM a -> ReduceM b
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)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> f a -> f (f 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' (a
x,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 a b. ReduceM (a -> b) -> ReduceM a -> ReduceM 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' (a
x,b
y,c
z) =
do (x,(y,z)) <- (a, (b, c)) -> ReduceM (a, (b, c))
forall t. Normalise t => t -> ReduceM t
normalise' (a
x,(b
y,c
z))
return (x,y,z)
instance Normalise Bool where
normalise' :: Bool -> ReduceM Bool
normalise' = Bool -> ReduceM Bool
forall a. a -> ReduceM a
forall (m :: * -> *) a. Monad m => a -> m a
return
instance Normalise Char where
normalise' :: Char -> ReduceM Char
normalise' = Char -> ReduceM Char
forall a. a -> ReduceM a
forall (m :: * -> *) a. Monad m => a -> m a
return
instance Normalise Int where
normalise' :: Int -> ReduceM Int
normalise' = Int -> ReduceM Int
forall a. a -> ReduceM a
forall (m :: * -> *) a. Monad m => a -> m a
return
instance Normalise DBPatVar where
normalise' :: DBPatVar -> ReduceM DBPatVar
normalise' = DBPatVar -> ReduceM DBPatVar
forall a. a -> ReduceM a
forall (m :: * -> *) a. Monad m => a -> m a
return
instance Normalise Sort where
normalise' :: Sort -> ReduceM Sort
normalise' Sort
s = do
s <- Sort -> ReduceM Sort
forall t. Reduce t => t -> ReduceM t
reduce' Sort
s
case s of
PiSort Dom' Term Term
a Sort
s1 Abs Sort
s2 -> Dom' Term Term -> Sort -> Abs Sort -> Sort
piSort (Dom' Term Term -> Sort -> Abs Sort -> Sort)
-> ReduceM (Dom' Term Term) -> ReduceM (Sort -> Abs Sort -> Sort)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Dom' Term Term -> ReduceM (Dom' Term Term)
forall t. Normalise t => t -> ReduceM t
normalise' Dom' Term Term
a ReduceM (Sort -> Abs Sort -> Sort)
-> ReduceM Sort -> ReduceM (Abs Sort -> Sort)
forall a b. ReduceM (a -> b) -> ReduceM a -> ReduceM b
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
s1 ReduceM (Abs Sort -> Sort) -> ReduceM (Abs Sort) -> ReduceM Sort
forall a b. ReduceM (a -> b) -> ReduceM a -> ReduceM b
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
s2
FunSort Sort
s1 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 a b. ReduceM (a -> b) -> ReduceM a -> ReduceM b
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 Sort
s -> Sort -> Sort
univSort (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
Univ Univ
u Level
s -> Univ -> Level -> Sort
forall t. Univ -> Level' t -> Sort' t
Univ Univ
u (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 Univ
_ Integer
_ -> Sort -> ReduceM Sort
forall a. a -> ReduceM a
forall (m :: * -> *) a. Monad m => a -> m a
return Sort
s
Sort
SizeUniv -> Sort -> ReduceM Sort
forall a. a -> ReduceM a
forall (m :: * -> *) a. Monad m => a -> m a
return Sort
forall t. Sort' t
SizeUniv
Sort
LockUniv -> Sort -> ReduceM Sort
forall a. a -> ReduceM a
forall (m :: * -> *) a. Monad m => a -> m a
return Sort
forall t. Sort' t
LockUniv
Sort
LevelUniv -> Sort -> ReduceM Sort
forall a. a -> ReduceM a
forall (m :: * -> *) a. Monad m => a -> m a
return Sort
forall t. Sort' t
LevelUniv
Sort
IntervalUniv -> Sort -> ReduceM Sort
forall a. a -> ReduceM a
forall (m :: * -> *) a. Monad m => a -> m a
return Sort
forall t. Sort' t
IntervalUniv
MetaS MetaId
x Elims
es -> Sort -> ReduceM Sort
forall a. a -> ReduceM a
forall (m :: * -> *) a. Monad m => a -> m a
return Sort
s
DefS QName
d Elims
es -> Sort -> ReduceM Sort
forall a. a -> ReduceM a
forall (m :: * -> *) a. Monad m => a -> m a
return Sort
s
DummyS{} -> Sort -> ReduceM Sort
forall a. a -> ReduceM a
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 Sort
s 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 a b. ReduceM (a -> b) -> ReduceM a -> ReduceM b
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' 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 = \case
Var Int
n 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 ConHead
c ConInfo
ci 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 QName
f 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 MetaId
x 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
v :: Term
v@(Lit Literal
_) -> Term -> ReduceM Term
forall a. a -> ReduceM a
forall (m :: * -> *) a. Monad m => a -> m a
return Term
v
Level 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 ArgInfo
h 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 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 Dom Type
a 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)
v :: Term
v@DontCare{}-> Term -> ReduceM Term
forall a. a -> ReduceM a
forall (m :: * -> *) a. Monad m => a -> m a
return Term
v
v :: Term
v@Dummy{} -> Term -> ReduceM Term
forall a. a -> ReduceM a
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 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 ProjOrigin
o QName
f)= Elim' t -> ReduceM (Elim' t)
forall a. a -> ReduceM a
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 t
x t
y 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 a b. ReduceM (a -> b) -> ReduceM a -> ReduceM b
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 a b. ReduceM (a -> b) -> ReduceM a -> ReduceM b
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 Integer
m [PlusLevel]
as) = Integer -> [PlusLevel] -> Level
levelMax Integer
m ([PlusLevel] -> Level) -> ReduceM [PlusLevel] -> ReduceM Level
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [PlusLevel] -> ReduceM [PlusLevel]
forall t. Normalise t => t -> ReduceM t
normalise' [PlusLevel]
as
instance Normalise PlusLevel where
normalise' :: PlusLevel -> ReduceM PlusLevel
normalise' (Plus Integer
n Term
l) = Integer -> Term -> PlusLevel
forall t. Integer -> t -> PlusLevel' t
Plus Integer
n (Term -> PlusLevel) -> ReduceM Term -> ReduceM PlusLevel
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term -> ReduceM Term
forall t. Normalise t => t -> ReduceM t
normalise' Term
l
instance (Subst a, Normalise a) => Normalise (Abs a) where
normalise' :: Abs a -> ReduceM (Abs a)
normalise' a :: Abs a
a@(Abs [Char]
x a
_) = [Char] -> a -> Abs a
forall a. [Char] -> a -> Abs a
Abs [Char]
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 a (m :: * -> *) b.
(Subst 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 [Char]
x a
v) = [Char] -> a -> Abs a
forall a. [Char] -> a -> Abs a
NoAbs [Char]
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' Arg t
a
| Arg t -> Bool
forall a. LensRelevance a => a -> Bool
isIrrelevant Arg t
a = Arg t -> ReduceM (Arg t)
forall a. a -> ReduceM a
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)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Arg a -> f (Arg 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)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Dom' Term a -> f (Dom' Term 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' Closure a
cl = do
x <- Closure a -> (a -> ReduceM a) -> ReduceM a
forall c a b. LensClosure c a => c -> (a -> ReduceM b) -> ReduceM b
enterClosure Closure a
cl a -> ReduceM a
forall t. Normalise t => t -> ReduceM t
normalise'
return $ cl { clValue = x }
instance (Subst a, Normalise a) => Normalise (Tele a) where
normalise' :: Tele a -> ReduceM (Tele a)
normalise' Tele a
EmptyTel = Tele a -> ReduceM (Tele a)
forall a. a -> ReduceM a
forall (m :: * -> *) a. Monad m => a -> m a
return Tele a
forall a. Tele a
EmptyTel
normalise' (ExtendTel a
a 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 Set ProblemId
pid Blocker
unblock Closure Constraint
c) = Set ProblemId -> Blocker -> Closure Constraint -> ProblemConstraint
PConstr Set ProblemId
pid Blocker
unblock (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 Comparison
cmp CompareAs
t Term
u Term
v) = do
(t,u,v) <- (CompareAs, Term, Term) -> ReduceM (CompareAs, Term, Term)
forall t. Normalise t => t -> ReduceM t
normalise' (CompareAs
t,Term
u,Term
v)
return $ ValueCmp cmp t u v
normalise' (ValueCmpOnFace Comparison
cmp Term
p Type
t Term
u Term
v) = do
((p,t),u,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)
return $ ValueCmpOnFace cmp p t u v
normalise' (ElimCmp [Polarity]
cmp [IsForced]
fs Type
t Term
v Elims
as 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 a b. ReduceM (a -> b) -> ReduceM a -> ReduceM b
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 a b. ReduceM (a -> b) -> ReduceM a -> ReduceM b
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 a b. ReduceM (a -> b) -> ReduceM a -> ReduceM b
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 Comparison
cmp Level
u 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' (SortCmp Comparison
cmp Sort
a 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' (UnBlock MetaId
m) = Constraint -> ReduceM Constraint
forall a. a -> ReduceM a
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 MetaId
m Maybe [Candidate]
cs) = MetaId -> Maybe [Candidate] -> Constraint
FindInstance MetaId
m (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)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Maybe a -> m (Maybe b)
mapM [Candidate] -> ReduceM [Candidate]
forall t. Normalise t => t -> ReduceM t
normalise' Maybe [Candidate]
cs
normalise' (ResolveInstanceHead QName
q) = Constraint -> ReduceM Constraint
forall a. a -> ReduceM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Constraint -> ReduceM Constraint)
-> Constraint -> ReduceM Constraint
forall a b. (a -> b) -> a -> b
$ QName -> Constraint
ResolveInstanceHead QName
q
normalise' (IsEmpty Range
r 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 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 a. a -> ReduceM a
forall (m :: * -> *) a. Monad m => a -> m a
return Constraint
c
normalise' (HasBiggerSort 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 Dom Type
a 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 Term
t Term
h Type
g) = Term -> Term -> Type -> Constraint
UnquoteTactic (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 a b. ReduceM (a -> b) -> ReduceM a -> ReduceM b
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 a b. ReduceM (a -> b) -> ReduceM a -> ReduceM b
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' (CheckLockedVars Term
a Type
b Arg Term
c Type
d) =
Term -> Type -> Arg Term -> Type -> Constraint
CheckLockedVars (Term -> Type -> Arg Term -> Type -> Constraint)
-> ReduceM Term -> ReduceM (Type -> Arg 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
a ReduceM (Type -> Arg Term -> Type -> Constraint)
-> ReduceM Type -> ReduceM (Arg Term -> Type -> Constraint)
forall a b. ReduceM (a -> b) -> ReduceM a -> ReduceM b
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
b ReduceM (Arg Term -> Type -> Constraint)
-> ReduceM (Arg Term) -> ReduceM (Type -> Constraint)
forall a b. ReduceM (a -> b) -> ReduceM a -> ReduceM b
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
c ReduceM (Type -> Constraint) -> ReduceM Type -> ReduceM Constraint
forall a b. ReduceM (a -> b) -> ReduceM a -> ReduceM b
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
d
normalise' (CheckDataSort QName
q Sort
s) = QName -> Sort -> Constraint
CheckDataSort QName
q (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
s
normalise' c :: Constraint
c@CheckMetaInst{} = Constraint -> ReduceM Constraint
forall a. a -> ReduceM a
forall (m :: * -> *) a. Monad m => a -> m a
return Constraint
c
normalise' (CheckType Type
t) = Type -> Constraint
CheckType (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' (UsableAtModality WhyCheckModality
cc Maybe Sort
ms Modality
mod Term
t) = (Maybe Sort -> Modality -> Term -> Constraint)
-> Modality -> Maybe Sort -> Term -> Constraint
forall a b c. (a -> b -> c) -> b -> a -> c
flip (WhyCheckModality -> Maybe Sort -> Modality -> Term -> Constraint
UsableAtModality WhyCheckModality
cc) Modality
mod (Maybe Sort -> Term -> Constraint)
-> ReduceM (Maybe Sort) -> ReduceM (Term -> Constraint)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Sort -> ReduceM (Maybe Sort)
forall t. Normalise t => t -> ReduceM t
normalise' Maybe Sort
ms ReduceM (Term -> Constraint) -> ReduceM Term -> ReduceM Constraint
forall a b. ReduceM (a -> b) -> ReduceM a -> ReduceM b
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
t
instance Normalise CompareAs where
normalise' :: CompareAs -> ReduceM CompareAs
normalise' (AsTermsOf 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' CompareAs
AsSizes = CompareAs -> ReduceM CompareAs
forall a. a -> ReduceM a
forall (m :: * -> *) a. Monad m => a -> m a
return CompareAs
AsSizes
normalise' CompareAs
AsTypes = CompareAs -> ReduceM CompareAs
forall a. a -> ReduceM a
forall (m :: * -> *) a. Monad m => a -> m a
return CompareAs
AsTypes
instance Normalise ConPatternInfo where
normalise' :: ConPatternInfo -> ReduceM ConPatternInfo
normalise' 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 (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \ Maybe (Arg Type)
t -> ConPatternInfo
i { conPType = t }
instance Normalise a => Normalise (Pattern' a) where
normalise' :: Pattern' a -> ReduceM (Pattern' a)
normalise' Pattern' a
p = case Pattern' a
p of
VarP PatternInfo
o 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 a. a -> ReduceM a
forall (m :: * -> *) a. Monad m => a -> m a
return Pattern' a
p
ConP ConHead
c ConPatternInfo
mt [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 a b. ReduceM (a -> b) -> ReduceM a -> ReduceM b
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 PatternInfo
o QName
q [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 PatternInfo
o 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 a. a -> ReduceM a
forall (m :: * -> *) a. Monad m => a -> m a
return Pattern' a
p
IApplyP PatternInfo
o Term
t Term
u 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 a b. ReduceM (a -> b) -> ReduceM a -> ReduceM b
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 a b. ReduceM (a -> b) -> ReduceM a -> ReduceM b
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 Int
n Elims
ps 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 a b. ReduceM (a -> b) -> ReduceM a -> ReduceM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> DisplayTerm -> ReduceM DisplayTerm
forall a. a -> ReduceM a
forall (m :: * -> *) a. Monad m => a -> m a
return DisplayTerm
v
instance Normalise Candidate where
normalise' :: Candidate -> ReduceM Candidate
normalise' (Candidate CandidateKind
q Term
u Type
t OverlapMode
ov) = CandidateKind -> Term -> Type -> OverlapMode -> Candidate
Candidate CandidateKind
q (Term -> Type -> OverlapMode -> Candidate)
-> ReduceM Term -> ReduceM (Type -> OverlapMode -> 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 -> OverlapMode -> Candidate)
-> ReduceM Type -> ReduceM (OverlapMode -> Candidate)
forall a b. ReduceM (a -> b) -> ReduceM a -> ReduceM b
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 (OverlapMode -> Candidate)
-> ReduceM OverlapMode -> ReduceM Candidate
forall a b. ReduceM (a -> b) -> ReduceM a -> ReduceM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> OverlapMode -> ReduceM OverlapMode
forall a. a -> ReduceM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure OverlapMode
ov
instance Normalise EqualityView where
normalise' :: EqualityView -> ReduceM EqualityView
normalise' (OtherType 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' (IdiomType Type
t) = Type -> EqualityView
IdiomType
(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 Sort
s QName
eq [Arg Term]
l Arg Term
t Arg Term
a 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 a b. ReduceM (a -> b) -> ReduceM a -> ReduceM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> QName -> ReduceM QName
forall a. a -> ReduceM a
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 a b. ReduceM (a -> b) -> ReduceM a -> ReduceM b
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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [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 a b. ReduceM (a -> b) -> ReduceM a -> ReduceM b
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 a b. ReduceM (a -> b) -> ReduceM a -> ReduceM b
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 a b. ReduceM (a -> b) -> ReduceM a -> ReduceM b
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)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> f a -> f (f 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 (WithArity t)
instance InstantiateFull t => InstantiateFull (IPBoundary' t)
instance (InstantiateFull a, InstantiateFull b) => InstantiateFull (a,b) where
instantiateFull' :: (a, b) -> ReduceM (a, b)
instantiateFull' (a
x,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 a b. ReduceM (a -> b) -> ReduceM a -> ReduceM 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' (a
x,b
y,c
z) =
do (x,(y,z)) <- (a, (b, c)) -> ReduceM (a, (b, c))
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' (a
x,(b
y,c
z))
return (x,y,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' (a
x,b
y,c
z,d
w) =
do (x,(y,z,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))
return (x,y,z,w)
instance InstantiateFull Bool where
instantiateFull' :: Bool -> ReduceM Bool
instantiateFull' = Bool -> ReduceM Bool
forall a. a -> ReduceM a
forall (m :: * -> *) a. Monad m => a -> m a
return
instance InstantiateFull Char where
instantiateFull' :: Char -> ReduceM Char
instantiateFull' = Char -> ReduceM Char
forall a. a -> ReduceM a
forall (m :: * -> *) a. Monad m => a -> m a
return
instance InstantiateFull Int where
instantiateFull' :: Int -> ReduceM Int
instantiateFull' = Int -> ReduceM Int
forall a. a -> ReduceM a
forall (m :: * -> *) a. Monad m => a -> m a
return
instance InstantiateFull ModuleName where
instantiateFull' :: ModuleName -> ReduceM ModuleName
instantiateFull' = ModuleName -> ReduceM ModuleName
forall a. a -> ReduceM a
forall (m :: * -> *) a. Monad m => a -> m a
return
instance InstantiateFull Name where
instantiateFull' :: Name -> ReduceM Name
instantiateFull' = Name -> ReduceM Name
forall a. a -> ReduceM a
forall (m :: * -> *) a. Monad m => a -> m a
return
instance InstantiateFull QName where
instantiateFull' :: QName -> ReduceM QName
instantiateFull' = QName -> ReduceM QName
forall a. a -> ReduceM a
forall (m :: * -> *) a. Monad m => a -> m a
return
instance InstantiateFull Scope where
instantiateFull' :: Scope -> ReduceM Scope
instantiateFull' = Scope -> ReduceM Scope
forall a. a -> ReduceM a
forall (m :: * -> *) a. Monad m => a -> m a
return
instance InstantiateFull ConHead where
instantiateFull' :: ConHead -> ReduceM ConHead
instantiateFull' = ConHead -> ReduceM ConHead
forall a. a -> ReduceM a
forall (m :: * -> *) a. Monad m => a -> m a
return
instance InstantiateFull DBPatVar where
instantiateFull' :: DBPatVar -> ReduceM DBPatVar
instantiateFull' = DBPatVar -> ReduceM DBPatVar
forall a. a -> ReduceM a
forall (m :: * -> *) a. Monad m => a -> m a
return
instance InstantiateFull PrimitiveId where
instantiateFull' :: PrimitiveId -> ReduceM PrimitiveId
instantiateFull' = PrimitiveId -> ReduceM PrimitiveId
forall a. a -> ReduceM a
forall (m :: * -> *) a. Monad m => a -> m a
return
instance InstantiateFull Sort where
instantiateFull' :: Sort -> ReduceM Sort
instantiateFull' Sort
s = do
s <- Sort -> ReduceM Sort
forall t. Instantiate t => t -> ReduceM t
instantiate' Sort
s
case s of
Univ Univ
u Level
n -> Univ -> Level -> Sort
forall t. Univ -> Level' t -> Sort' t
Univ Univ
u (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 Dom' Term Term
a Sort
s1 Abs Sort
s2 -> Dom' Term Term -> Sort -> Abs Sort -> Sort
piSort (Dom' Term Term -> Sort -> Abs Sort -> Sort)
-> ReduceM (Dom' Term Term) -> ReduceM (Sort -> Abs Sort -> Sort)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Dom' Term Term -> ReduceM (Dom' Term Term)
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' Dom' Term Term
a ReduceM (Sort -> Abs Sort -> Sort)
-> ReduceM Sort -> ReduceM (Abs Sort -> Sort)
forall a b. ReduceM (a -> b) -> ReduceM a -> ReduceM b
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
s1 ReduceM (Abs Sort -> Sort) -> ReduceM (Abs Sort) -> ReduceM Sort
forall a b. ReduceM (a -> b) -> ReduceM a -> ReduceM b
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
s2
FunSort Sort
s1 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 a b. ReduceM (a -> b) -> ReduceM a -> ReduceM b
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 Sort
s -> Sort -> Sort
univSort (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 Univ
_ Integer
_ -> Sort -> ReduceM Sort
forall a. a -> ReduceM a
forall (m :: * -> *) a. Monad m => a -> m a
return Sort
s
Sort
SizeUniv -> Sort -> ReduceM Sort
forall a. a -> ReduceM a
forall (m :: * -> *) a. Monad m => a -> m a
return Sort
s
Sort
LockUniv -> Sort -> ReduceM Sort
forall a. a -> ReduceM a
forall (m :: * -> *) a. Monad m => a -> m a
return Sort
s
Sort
LevelUniv -> Sort -> ReduceM Sort
forall a. a -> ReduceM a
forall (m :: * -> *) a. Monad m => a -> m a
return Sort
s
Sort
IntervalUniv -> Sort -> ReduceM Sort
forall a. a -> ReduceM a
forall (m :: * -> *) a. Monad m => a -> m a
return Sort
s
MetaS MetaId
x 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 QName
d 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 a. a -> ReduceM a
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 Sort
s 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 a b. ReduceM (a -> b) -> ReduceM a -> ReduceM b
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' = Term -> ReduceM Term
forall t. Instantiate t => t -> ReduceM t
instantiate' (Term -> ReduceM Term)
-> (Term -> ReduceM Term) -> Term -> ReduceM Term
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Term -> ReduceM Term
recurse (Term -> ReduceM Term)
-> (Term -> ReduceM Term) -> Term -> ReduceM Term
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Term -> ReduceM Term
forall (m :: * -> *).
(MonadTCEnv m, HasConstInfo m, HasOptions m) =>
Term -> m Term
etaOnce
where
recurse :: Term -> ReduceM Term
recurse = \case
Var Int
n 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 ConHead
c ConInfo
ci 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 QName
f 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 MetaId
x 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
v :: Term
v@Lit{} -> Term -> ReduceM Term
forall a. a -> ReduceM a
forall (m :: * -> *) a. Monad m => a -> m a
return Term
v
Level 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 ArgInfo
h 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 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 Dom Type
a 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 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
v :: Term
v@Dummy{} -> Term -> ReduceM Term
forall a. a -> ReduceM a
forall (m :: * -> *) a. Monad m => a -> m a
return Term
v
instance InstantiateFull Level where
instantiateFull' :: Level -> ReduceM Level
instantiateFull' (Max Integer
m [PlusLevel]
as) = Integer -> [PlusLevel] -> Level
levelMax Integer
m ([PlusLevel] -> Level) -> ReduceM [PlusLevel] -> ReduceM Level
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [PlusLevel] -> ReduceM [PlusLevel]
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' [PlusLevel]
as
instance InstantiateFull PlusLevel where
instantiateFull' :: PlusLevel -> ReduceM PlusLevel
instantiateFull' (Plus Integer
n Term
l) = Integer -> Term -> PlusLevel
forall t. Integer -> t -> PlusLevel' t
Plus Integer
n (Term -> PlusLevel) -> ReduceM Term -> ReduceM PlusLevel
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term -> ReduceM Term
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' Term
l
instance InstantiateFull Substitution where
instantiateFull' :: Substitution' Term -> ReduceM (Substitution' Term)
instantiateFull' Substitution' Term
sigma =
case Substitution' Term
sigma of
Substitution' Term
IdS -> Substitution' Term -> ReduceM (Substitution' Term)
forall a. a -> ReduceM a
forall (m :: * -> *) a. Monad m => a -> m a
return Substitution' Term
forall a. Substitution' a
IdS
EmptyS Impossible
err -> Substitution' Term -> ReduceM (Substitution' Term)
forall a. a -> ReduceM a
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
$ Impossible -> Substitution' Term
forall a. Impossible -> Substitution' a
EmptyS Impossible
err
Wk Int
n 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 Int
n 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 Impossible
bot Int
n Substitution' Term
sigma -> Impossible -> Int -> Substitution' Term -> Substitution' Term
forall a. Impossible -> Int -> Substitution' a -> Substitution' a
Strengthen Impossible
bot 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
Term
t :# 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 a b. ReduceM (a -> b) -> ReduceM a -> ReduceM b
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' 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 (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \ Maybe (Arg Type)
t -> ConPatternInfo
i { conPType = t }
instance InstantiateFull a => InstantiateFull (Pattern' a) where
instantiateFull' :: Pattern' a -> ReduceM (Pattern' a)
instantiateFull' (VarP PatternInfo
o 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 PatternInfo
o 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 ConHead
n ConPatternInfo
mt [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 a b. ReduceM (a -> b) -> ReduceM a -> ReduceM b
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 PatternInfo
o QName
q [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 a. a -> ReduceM 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 a. a -> ReduceM a
forall (m :: * -> *) a. Monad m => a -> m a
return Pattern' a
p
instantiateFull' (IApplyP PatternInfo
o Term
t Term
u 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 a b. ReduceM (a -> b) -> ReduceM a -> ReduceM b
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 a b. ReduceM (a -> b) -> ReduceM a -> ReduceM b
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 a, InstantiateFull a) => InstantiateFull (Abs a) where
instantiateFull' :: Abs a -> ReduceM (Abs a)
instantiateFull' a :: Abs a
a@(Abs [Char]
x a
_) = [Char] -> a -> Abs a
forall a. [Char] -> a -> Abs a
Abs [Char]
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 a (m :: * -> *) b.
(Subst 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 [Char]
x a
a) = [Char] -> a -> Abs a
forall a. [Char] -> a -> Abs a
NoAbs [Char]
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 ArgInfo
i Maybe NamedName
n Bool
b Maybe t
tac e
x) = ArgInfo -> Maybe NamedName -> Bool -> Maybe t -> e -> Dom' t e
forall t e.
ArgInfo -> Maybe NamedName -> Bool -> Maybe t -> e -> Dom' t e
Dom ArgInfo
i Maybe NamedName
n Bool
b (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 a b. ReduceM (a -> b) -> ReduceM a -> ReduceM b
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 LetBinding where
instantiateFull' :: LetBinding -> ReduceM LetBinding
instantiateFull' (LetBinding Origin
o Term
v Dom Type
t) = Origin -> Term -> Dom Type -> LetBinding
LetBinding Origin
o (Term -> Dom Type -> LetBinding)
-> ReduceM Term -> ReduceM (Dom Type -> LetBinding)
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 ReduceM (Dom Type -> LetBinding)
-> ReduceM (Dom Type) -> ReduceM LetBinding
forall a b. ReduceM (a -> b) -> ReduceM a -> ReduceM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Dom Type -> ReduceM (Dom Type)
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' Dom Type
t
instance InstantiateFull t => InstantiateFull (Open t) where
instantiateFull' :: Open t -> ReduceM (Open t)
instantiateFull' (OpenThing CheckpointId
checkpoint Map CheckpointId (Substitution' Term)
checkpoints ModuleNameHash
modl t
t) =
CheckpointId
-> Map CheckpointId (Substitution' Term)
-> ModuleNameHash
-> t
-> Open t
forall a.
CheckpointId
-> Map CheckpointId (Substitution' Term)
-> ModuleNameHash
-> a
-> Open a
OpenThing CheckpointId
checkpoint
(Map CheckpointId (Substitution' Term)
-> ModuleNameHash -> t -> Open t)
-> ReduceM (Map CheckpointId (Substitution' Term))
-> ReduceM (ModuleNameHash -> t -> Open t)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Map CheckpointId (Substitution' Term)
-> ReduceM (Map CheckpointId (Substitution' Term))
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' (Map CheckpointId (Substitution' Term)
-> ReduceM (Map CheckpointId (Substitution' Term)))
-> ReduceM (Map CheckpointId (Substitution' Term))
-> ReduceM (Map CheckpointId (Substitution' Term))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Map CheckpointId (Substitution' Term)
-> ReduceM (Map CheckpointId (Substitution' Term))
forall {m :: * -> *} {a}.
MonadTCEnv m =>
Map CheckpointId a -> m (Map CheckpointId a)
prune Map CheckpointId (Substitution' Term)
checkpoints)
ReduceM (ModuleNameHash -> t -> Open t)
-> ReduceM ModuleNameHash -> ReduceM (t -> Open t)
forall a b. ReduceM (a -> b) -> ReduceM a -> ReduceM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ModuleNameHash -> ReduceM ModuleNameHash
forall a. a -> ReduceM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ModuleNameHash
modl
ReduceM (t -> Open t) -> ReduceM t -> ReduceM (Open t)
forall a b. ReduceM (a -> b) -> ReduceM a -> ReduceM b
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
where
prune :: Map CheckpointId a -> m (Map CheckpointId a)
prune Map CheckpointId a
cps = do
inscope <- Lens' TCEnv (Map CheckpointId (Substitution' Term))
-> m (Map CheckpointId (Substitution' Term))
forall (m :: * -> *) a. MonadTCEnv m => Lens' TCEnv a -> m a
viewTC (Map CheckpointId (Substitution' Term)
-> f (Map CheckpointId (Substitution' Term)))
-> TCEnv -> f TCEnv
Lens' TCEnv (Map CheckpointId (Substitution' Term))
eCheckpoints
return $ cps `Map.intersection` inscope
instance InstantiateFull a => InstantiateFull (Closure a) where
instantiateFull' :: Closure a -> ReduceM (Closure a)
instantiateFull' Closure a
cl = do
x <- Closure a -> (a -> ReduceM a) -> ReduceM a
forall c a b. LensClosure c a => c -> (a -> ReduceM b) -> ReduceM b
enterClosure Closure a
cl a -> ReduceM a
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull'
return $ cl { clValue = x }
instance InstantiateFull ProblemConstraint where
instantiateFull' :: ProblemConstraint -> ReduceM ProblemConstraint
instantiateFull' (PConstr Set ProblemId
p Blocker
u Closure Constraint
c) = Set ProblemId -> Blocker -> Closure Constraint -> ProblemConstraint
PConstr Set ProblemId
p Blocker
u (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' = \case
ValueCmp Comparison
cmp CompareAs
t Term
u Term
v -> do
(t,u,v) <- (CompareAs, Term, Term) -> ReduceM (CompareAs, Term, Term)
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' (CompareAs
t,Term
u,Term
v)
return $ ValueCmp cmp t u v
ValueCmpOnFace Comparison
cmp Term
p Type
t Term
u Term
v -> do
((p,t),u,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)
return $ ValueCmpOnFace cmp p t u v
ElimCmp [Polarity]
cmp [IsForced]
fs Type
t Term
v Elims
as 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 a b. ReduceM (a -> b) -> ReduceM a -> ReduceM b
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 a b. ReduceM (a -> b) -> ReduceM a -> ReduceM b
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 a b. ReduceM (a -> b) -> ReduceM a -> ReduceM b
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 Comparison
cmp Level
u 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)
SortCmp Comparison
cmp Sort
a 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)
UnBlock MetaId
m -> Constraint -> ReduceM Constraint
forall a. a -> ReduceM a
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 MetaId
m Maybe [Candidate]
cs -> MetaId -> Maybe [Candidate] -> Constraint
FindInstance MetaId
m (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)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Maybe a -> m (Maybe b)
mapM [Candidate] -> ReduceM [Candidate]
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' Maybe [Candidate]
cs
ResolveInstanceHead QName
q -> Constraint -> ReduceM Constraint
forall a. a -> ReduceM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Constraint -> ReduceM Constraint)
-> Constraint -> ReduceM Constraint
forall a b. (a -> b) -> a -> b
$ QName -> Constraint
ResolveInstanceHead QName
q
IsEmpty Range
r 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 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 a. a -> ReduceM a
forall (m :: * -> *) a. Monad m => a -> m a
return Constraint
c
HasBiggerSort 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 Dom Type
a 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 Term
t Term
g Type
h -> Term -> Term -> Type -> Constraint
UnquoteTactic (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 a b. ReduceM (a -> b) -> ReduceM a -> ReduceM b
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 a b. ReduceM (a -> b) -> ReduceM a -> ReduceM b
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
CheckLockedVars Term
a Type
b Arg Term
c Type
d ->
Term -> Type -> Arg Term -> Type -> Constraint
CheckLockedVars (Term -> Type -> Arg Term -> Type -> Constraint)
-> ReduceM Term -> ReduceM (Type -> Arg 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
a ReduceM (Type -> Arg Term -> Type -> Constraint)
-> ReduceM Type -> ReduceM (Arg Term -> Type -> Constraint)
forall a b. ReduceM (a -> b) -> ReduceM a -> ReduceM b
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
b ReduceM (Arg Term -> Type -> Constraint)
-> ReduceM (Arg Term) -> ReduceM (Type -> Constraint)
forall a b. ReduceM (a -> b) -> ReduceM a -> ReduceM b
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
c ReduceM (Type -> Constraint) -> ReduceM Type -> ReduceM Constraint
forall a b. ReduceM (a -> b) -> ReduceM a -> ReduceM b
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
d
CheckDataSort QName
q Sort
s -> QName -> Sort -> Constraint
CheckDataSort QName
q (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
s
c :: Constraint
c@CheckMetaInst{} -> Constraint -> ReduceM Constraint
forall a. a -> ReduceM a
forall (m :: * -> *) a. Monad m => a -> m a
return Constraint
c
CheckType Type
t -> Type -> Constraint
CheckType (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
UsableAtModality WhyCheckModality
cc Maybe Sort
ms Modality
mod Term
t -> (Maybe Sort -> Modality -> Term -> Constraint)
-> Modality -> Maybe Sort -> Term -> Constraint
forall a b c. (a -> b -> c) -> b -> a -> c
flip (WhyCheckModality -> Maybe Sort -> Modality -> Term -> Constraint
UsableAtModality WhyCheckModality
cc) Modality
mod (Maybe Sort -> Term -> Constraint)
-> ReduceM (Maybe Sort) -> ReduceM (Term -> Constraint)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Sort -> ReduceM (Maybe Sort)
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' Maybe Sort
ms ReduceM (Term -> Constraint) -> ReduceM Term -> ReduceM Constraint
forall a b. ReduceM (a -> b) -> ReduceM a -> ReduceM b
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
t
instance InstantiateFull CompareAs where
instantiateFull' :: CompareAs -> ReduceM CompareAs
instantiateFull' (AsTermsOf 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' CompareAs
AsSizes = CompareAs -> ReduceM CompareAs
forall a. a -> ReduceM a
forall (m :: * -> *) a. Monad m => a -> m a
return CompareAs
AsSizes
instantiateFull' CompareAs
AsTypes = CompareAs -> ReduceM CompareAs
forall a. a -> ReduceM a
forall (m :: * -> *) a. Monad m => a -> m a
return CompareAs
AsTypes
instance InstantiateFull Signature where
instantiateFull' :: Signature -> ReduceM Signature
instantiateFull' (Sig Sections
a Definitions
b RewriteRuleMap
c InstanceTable
d) = Sections
-> Definitions -> RewriteRuleMap -> InstanceTable -> Signature
Sig
(Sections
-> Definitions -> RewriteRuleMap -> InstanceTable -> Signature)
-> ReduceM Sections
-> ReduceM
(Definitions -> RewriteRuleMap -> InstanceTable -> Signature)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sections -> ReduceM Sections
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' Sections
a
ReduceM
(Definitions -> RewriteRuleMap -> InstanceTable -> Signature)
-> ReduceM Definitions
-> ReduceM (RewriteRuleMap -> InstanceTable -> Signature)
forall a b. ReduceM (a -> b) -> ReduceM a -> ReduceM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Definitions -> ReduceM Definitions
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' Definitions
b
ReduceM (RewriteRuleMap -> InstanceTable -> Signature)
-> ReduceM RewriteRuleMap -> ReduceM (InstanceTable -> Signature)
forall a b. ReduceM (a -> b) -> ReduceM a -> ReduceM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RewriteRuleMap -> ReduceM RewriteRuleMap
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' RewriteRuleMap
c
ReduceM (InstanceTable -> Signature)
-> ReduceM InstanceTable -> ReduceM Signature
forall a b. ReduceM (a -> b) -> ReduceM a -> ReduceM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> InstanceTable -> ReduceM InstanceTable
forall a. a -> ReduceM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure InstanceTable
d
instance InstantiateFull Section where
instantiateFull' :: Section -> ReduceM Section
instantiateFull' (Section 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 a, InstantiateFull a) => InstantiateFull (Tele a) where
instantiateFull' :: Tele a -> ReduceM (Tele a)
instantiateFull' Tele a
EmptyTel = Tele a -> ReduceM (Tele a)
forall a. a -> ReduceM a
forall (m :: * -> *) a. Monad m => a -> m a
return Tele a
forall a. Tele a
EmptyTel
instantiateFull' (ExtendTel a
a 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, df, d) <- (Type, [LocalDisplayForm], Defn)
-> ReduceM (Type, [LocalDisplayForm], Defn)
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' (Type
t, [LocalDisplayForm]
df, Defn
d)
return $ def{ defType = t, defDisplay = df, theDef = d }
instance InstantiateFull NLPat where
instantiateFull' :: NLPat -> ReduceM NLPat
instantiateFull' (PVar Int
x [Arg Int]
y) = NLPat -> ReduceM NLPat
forall a. a -> ReduceM a
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 QName
x 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 a b. ReduceM (a -> b) -> ReduceM a -> ReduceM b
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 ArgInfo
x 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 Dom NLPType
x 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 a b. ReduceM (a -> b) -> ReduceM a -> ReduceM b
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 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 Int
x 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 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 NLPSort
s 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 a b. ReduceM (a -> b) -> ReduceM a -> ReduceM b
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' (PUniv Univ
u NLPat
x) = Univ -> NLPat -> NLPSort
PUniv Univ
u (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 Univ
f Integer
n) = NLPSort -> ReduceM NLPSort
forall a. a -> ReduceM a
forall (m :: * -> *) a. Monad m => a -> m a
return (NLPSort -> ReduceM NLPSort) -> NLPSort -> ReduceM NLPSort
forall a b. (a -> b) -> a -> b
$ Univ -> Integer -> NLPSort
PInf Univ
f Integer
n
instantiateFull' NLPSort
PSizeUniv = NLPSort -> ReduceM NLPSort
forall a. a -> ReduceM a
forall (m :: * -> *) a. Monad m => a -> m a
return NLPSort
PSizeUniv
instantiateFull' NLPSort
PLockUniv = NLPSort -> ReduceM NLPSort
forall a. a -> ReduceM a
forall (m :: * -> *) a. Monad m => a -> m a
return NLPSort
PLockUniv
instantiateFull' NLPSort
PLevelUniv = NLPSort -> ReduceM NLPSort
forall a. a -> ReduceM a
forall (m :: * -> *) a. Monad m => a -> m a
return NLPSort
PLevelUniv
instantiateFull' NLPSort
PIntervalUniv = NLPSort -> ReduceM NLPSort
forall a. a -> ReduceM a
forall (m :: * -> *) a. Monad m => a -> m a
return NLPSort
PIntervalUniv
instance InstantiateFull RewriteRule where
instantiateFull' :: RewriteRule -> ReduceM RewriteRule
instantiateFull' (RewriteRule QName
q Telescope
gamma QName
f PElims
ps Term
rhs Type
t Bool
c) =
QName
-> Telescope
-> QName
-> PElims
-> Term
-> Type
-> Bool
-> RewriteRule
RewriteRule QName
q
(Telescope
-> QName -> PElims -> Term -> Type -> Bool -> RewriteRule)
-> ReduceM Telescope
-> ReduceM (QName -> PElims -> Term -> Type -> Bool -> 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 -> Bool -> RewriteRule)
-> ReduceM QName
-> ReduceM (PElims -> Term -> Type -> Bool -> RewriteRule)
forall a b. ReduceM (a -> b) -> ReduceM a -> ReduceM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> QName -> ReduceM QName
forall a. a -> ReduceM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure QName
f
ReduceM (PElims -> Term -> Type -> Bool -> RewriteRule)
-> ReduceM PElims -> ReduceM (Term -> Type -> Bool -> RewriteRule)
forall a b. ReduceM (a -> b) -> ReduceM a -> ReduceM b
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 -> Bool -> RewriteRule)
-> ReduceM Term -> ReduceM (Type -> Bool -> RewriteRule)
forall a b. ReduceM (a -> b) -> ReduceM a -> ReduceM b
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 -> Bool -> RewriteRule)
-> ReduceM Type -> ReduceM (Bool -> RewriteRule)
forall a b. ReduceM (a -> b) -> ReduceM a -> ReduceM b
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 -> RewriteRule)
-> ReduceM Bool -> ReduceM RewriteRule
forall a b. ReduceM (a -> b) -> ReduceM a -> ReduceM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Bool -> ReduceM Bool
forall a. a -> ReduceM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
c
instance InstantiateFull DisplayForm where
instantiateFull' :: DisplayForm -> ReduceM DisplayForm
instantiateFull' (Display Int
n Elims
ps 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' Term
v Elims
es) = Term -> Elims -> DisplayTerm
DTerm' (Term -> Elims -> DisplayTerm)
-> ReduceM Term -> ReduceM (Elims -> 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 ReduceM (Elims -> DisplayTerm)
-> ReduceM Elims -> ReduceM DisplayTerm
forall a b. ReduceM (a -> b) -> ReduceM a -> ReduceM b
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
es
instantiateFull' (DDot' Term
v Elims
es) = Term -> Elims -> DisplayTerm
DDot' (Term -> Elims -> DisplayTerm)
-> ReduceM Term -> ReduceM (Elims -> 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 ReduceM (Elims -> DisplayTerm)
-> ReduceM Elims -> ReduceM DisplayTerm
forall a b. ReduceM (a -> b) -> ReduceM a -> ReduceM b
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
es
instantiateFull' (DCon ConHead
c ConInfo
ci [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 QName
c [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 DisplayTerm
v [DisplayTerm]
vs 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' Defn
d = case Defn
d of
Axiom{} -> Defn -> ReduceM Defn
forall a. a -> ReduceM a
forall (m :: * -> *) a. Monad m => a -> m a
return Defn
d
DataOrRecSig{} -> Defn -> ReduceM Defn
forall a. a -> ReduceM a
forall (m :: * -> *) a. Monad m => a -> m a
return Defn
d
GeneralizableVar{} -> Defn -> ReduceM Defn
forall a. a -> ReduceM a
forall (m :: * -> *) a. Monad m => a -> m a
return Defn
d
AbstractDefn 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, cc, cov, 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)
extLam <- instantiateFull' extLam
return $ d { funClauses = cs, funCompiled = cc, funCovering = cov, funInv = inv, funExtLam = extLam }
Datatype{ dataSort :: Defn -> Sort
dataSort = Sort
s, dataClause :: Defn -> Maybe Clause
dataClause = Maybe Clause
cl } -> do
s <- Sort -> ReduceM Sort
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' Sort
s
cl <- instantiateFull' cl
return $ d { dataSort = s, dataClause = cl }
Record{ recClause :: Defn -> Maybe Clause
recClause = Maybe Clause
cl, recTel :: Defn -> Telescope
recTel = Telescope
tel } -> do
cl <- Maybe Clause -> ReduceM (Maybe Clause)
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' Maybe Clause
cl
tel <- instantiateFull' tel
return $ d { recClause = cl, recTel = tel }
Constructor{} -> Defn -> ReduceM Defn
forall a. a -> ReduceM a
forall (m :: * -> *) a. Monad m => a -> m a
return Defn
d
Primitive{ primClauses :: Defn -> [Clause]
primClauses = [Clause]
cs } -> do
cs <- [Clause] -> ReduceM [Clause]
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' [Clause]
cs
return $ d { primClauses = cs }
PrimitiveSort{} -> Defn -> ReduceM Defn
forall a. a -> ReduceM a
forall (m :: * -> *) a. Monad m => a -> m a
return Defn
d
instance InstantiateFull ExtLamInfo where
instantiateFull' :: ExtLamInfo -> ReduceM ExtLamInfo
instantiateFull' e :: ExtLamInfo
e@(ExtLamInfo { extLamSys :: ExtLamInfo -> Maybe System
extLamSys = Maybe System
sys}) = do
sys <- Maybe System -> ReduceM (Maybe System)
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' Maybe System
sys
return $ e { extLamSys = sys}
instance InstantiateFull System where
instantiateFull' :: System -> ReduceM System
instantiateFull' (System Telescope
tel [(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 a b. ReduceM (a -> b) -> ReduceM a -> ReduceM b
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' FunctionInverse
NotInjective = FunctionInverse -> ReduceM FunctionInverse
forall a. a -> ReduceM a
forall (m :: * -> *) a. Monad m => a -> m a
return FunctionInverse
forall c. FunctionInverse' c
NotInjective
instantiateFull' (Inverse 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 Bool
cop Map QName (WithArity a)
cs Maybe (ConHead, WithArity a)
eta Map Literal a
ls Maybe a
m Maybe Bool
b 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 a b. ReduceM (a -> b) -> ReduceM a -> ReduceM b
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 a b. ReduceM (a -> b) -> ReduceM a -> ReduceM b
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 a b. ReduceM (a -> b) -> ReduceM a -> ReduceM b
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 a b. ReduceM (a -> b) -> ReduceM a -> ReduceM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe Bool -> ReduceM (Maybe Bool)
forall a. a -> ReduceM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Bool
b
ReduceM (Bool -> Case a) -> ReduceM Bool -> ReduceM (Case a)
forall a b. ReduceM (a -> b) -> ReduceM a -> ReduceM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Bool -> ReduceM Bool
forall a. a -> ReduceM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
lz
instance InstantiateFull CompiledClauses where
instantiateFull' :: CompiledClauses -> ReduceM CompiledClauses
instantiateFull' (Fail [Arg [Char]]
xs) = CompiledClauses -> ReduceM CompiledClauses
forall a. a -> ReduceM a
forall (m :: * -> *) a. Monad m => a -> m a
return (CompiledClauses -> ReduceM CompiledClauses)
-> CompiledClauses -> ReduceM CompiledClauses
forall a b. (a -> b) -> a -> b
$ [Arg [Char]] -> CompiledClauses
forall a. [Arg [Char]] -> CompiledClauses' a
Fail [Arg [Char]]
xs
instantiateFull' (Done [Arg [Char]]
m Term
t) = [Arg [Char]] -> Term -> CompiledClauses
forall a. [Arg [Char]] -> a -> CompiledClauses' a
Done [Arg [Char]]
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 Arg Int
n 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 Range
rl Range
rf Telescope
tel NAPs
ps Maybe Term
b Maybe (Arg Type)
t Bool
catchall Maybe Bool
exact Maybe Bool
recursive Maybe Bool
unreachable ExpandedEllipsis
ell Maybe ModuleName
wm) =
Range
-> Range
-> Telescope
-> NAPs
-> Maybe Term
-> Maybe (Arg Type)
-> Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> ExpandedEllipsis
-> Maybe ModuleName
-> Clause
Clause Range
rl Range
rf (Telescope
-> NAPs
-> Maybe Term
-> Maybe (Arg Type)
-> Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> ExpandedEllipsis
-> Maybe ModuleName
-> Clause)
-> ReduceM Telescope
-> ReduceM
(NAPs
-> Maybe Term
-> Maybe (Arg Type)
-> Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> ExpandedEllipsis
-> Maybe ModuleName
-> 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
-> Maybe Bool
-> ExpandedEllipsis
-> Maybe ModuleName
-> Clause)
-> ReduceM NAPs
-> ReduceM
(Maybe Term
-> Maybe (Arg Type)
-> Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> ExpandedEllipsis
-> Maybe ModuleName
-> Clause)
forall a b. ReduceM (a -> b) -> ReduceM a -> ReduceM b
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
-> Maybe Bool
-> ExpandedEllipsis
-> Maybe ModuleName
-> Clause)
-> ReduceM (Maybe Term)
-> ReduceM
(Maybe (Arg Type)
-> Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> ExpandedEllipsis
-> Maybe ModuleName
-> Clause)
forall a b. ReduceM (a -> b) -> ReduceM a -> ReduceM b
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
-> Maybe Bool
-> ExpandedEllipsis
-> Maybe ModuleName
-> Clause)
-> ReduceM (Maybe (Arg Type))
-> ReduceM
(Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> ExpandedEllipsis
-> Maybe ModuleName
-> Clause)
forall a b. ReduceM (a -> b) -> ReduceM a -> ReduceM b
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
-> Maybe Bool
-> ExpandedEllipsis
-> Maybe ModuleName
-> Clause)
-> ReduceM Bool
-> ReduceM
(Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> ExpandedEllipsis
-> Maybe ModuleName
-> Clause)
forall a b. ReduceM (a -> b) -> ReduceM a -> ReduceM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Bool -> ReduceM Bool
forall a. a -> ReduceM a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
catchall
ReduceM
(Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> ExpandedEllipsis
-> Maybe ModuleName
-> Clause)
-> ReduceM (Maybe Bool)
-> ReduceM
(Maybe Bool
-> Maybe Bool -> ExpandedEllipsis -> Maybe ModuleName -> Clause)
forall a b. ReduceM (a -> b) -> ReduceM a -> ReduceM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe Bool -> ReduceM (Maybe Bool)
forall a. a -> ReduceM a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Bool
exact
ReduceM
(Maybe Bool
-> Maybe Bool -> ExpandedEllipsis -> Maybe ModuleName -> Clause)
-> ReduceM (Maybe Bool)
-> ReduceM
(Maybe Bool -> ExpandedEllipsis -> Maybe ModuleName -> Clause)
forall a b. ReduceM (a -> b) -> ReduceM a -> ReduceM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe Bool -> ReduceM (Maybe Bool)
forall a. a -> ReduceM a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Bool
recursive
ReduceM
(Maybe Bool -> ExpandedEllipsis -> Maybe ModuleName -> Clause)
-> ReduceM (Maybe Bool)
-> ReduceM (ExpandedEllipsis -> Maybe ModuleName -> Clause)
forall a b. ReduceM (a -> b) -> ReduceM a -> ReduceM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe Bool -> ReduceM (Maybe Bool)
forall a. a -> ReduceM a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Bool
unreachable
ReduceM (ExpandedEllipsis -> Maybe ModuleName -> Clause)
-> ReduceM ExpandedEllipsis -> ReduceM (Maybe ModuleName -> Clause)
forall a b. ReduceM (a -> b) -> ReduceM a -> ReduceM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ExpandedEllipsis -> ReduceM ExpandedEllipsis
forall a. a -> ReduceM a
forall (m :: * -> *) a. Monad m => a -> m a
return ExpandedEllipsis
ell
ReduceM (Maybe ModuleName -> Clause)
-> ReduceM (Maybe ModuleName) -> ReduceM Clause
forall a b. ReduceM (a -> b) -> ReduceM a -> ReduceM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe ModuleName -> ReduceM (Maybe ModuleName)
forall a. a -> ReduceM a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ModuleName
wm
instance InstantiateFull Instantiation where
instantiateFull' :: Instantiation -> ReduceM Instantiation
instantiateFull' (Instantiation [Arg [Char]]
a Term
b) =
[Arg [Char]] -> Term -> Instantiation
Instantiation [Arg [Char]]
a (Term -> Instantiation) -> ReduceM Term -> ReduceM Instantiation
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term -> ReduceM Term
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' Term
b
instance InstantiateFull (Judgement MetaId) where
instantiateFull' :: Judgement MetaId -> ReduceM (Judgement MetaId)
instantiateFull' (HasType MetaId
a Comparison
b Type
c) =
MetaId -> Comparison -> Type -> Judgement MetaId
forall a. a -> Comparison -> Type -> Judgement a
HasType MetaId
a Comparison
b (Type -> Judgement MetaId)
-> ReduceM Type -> ReduceM (Judgement MetaId)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Type -> ReduceM Type
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' Type
c
instantiateFull' (IsSort MetaId
a Type
b) =
MetaId -> Type -> Judgement MetaId
forall a. a -> Type -> Judgement a
IsSort MetaId
a (Type -> Judgement MetaId)
-> ReduceM Type -> ReduceM (Judgement MetaId)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Type -> ReduceM Type
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' Type
b
instance InstantiateFull RemoteMetaVariable where
instantiateFull' :: RemoteMetaVariable -> ReduceM RemoteMetaVariable
instantiateFull' (RemoteMetaVariable Instantiation
a Modality
b Judgement MetaId
c) = Instantiation -> Modality -> Judgement MetaId -> RemoteMetaVariable
RemoteMetaVariable
(Instantiation
-> Modality -> Judgement MetaId -> RemoteMetaVariable)
-> ReduceM Instantiation
-> ReduceM (Modality -> Judgement MetaId -> RemoteMetaVariable)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Instantiation -> ReduceM Instantiation
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' Instantiation
a
ReduceM (Modality -> Judgement MetaId -> RemoteMetaVariable)
-> ReduceM Modality
-> ReduceM (Judgement MetaId -> RemoteMetaVariable)
forall a b. ReduceM (a -> b) -> ReduceM a -> ReduceM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Modality -> ReduceM Modality
forall a. a -> ReduceM a
forall (m :: * -> *) a. Monad m => a -> m a
return Modality
b
ReduceM (Judgement MetaId -> RemoteMetaVariable)
-> ReduceM (Judgement MetaId) -> ReduceM RemoteMetaVariable
forall a b. ReduceM (a -> b) -> ReduceM a -> ReduceM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Judgement MetaId -> ReduceM (Judgement MetaId)
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' Judgement MetaId
c
instance InstantiateFull Interface where
instantiateFull' :: Interface -> ReduceM Interface
instantiateFull'
(Interface Hash
h Text
s FileType
ft [(TopLevelModuleName, Hash)]
ms ModuleName
mod TopLevelModuleName
tlmod Map ModuleName Scope
scope ScopeInfo
inside Signature
sig RemoteMetaStore
_ DisplayForms
display Map QName Text
userwarn
Maybe Text
importwarn BuiltinThings (PrimitiveId, QName)
b Map [Char] ForeignCodeStack
foreignCode HighlightingInfo
highlighting [OptionsPragma]
libPragmas [OptionsPragma]
filePragmas
PragmaOptions
usedOpts PatternSynDefns
patsyns [TCWarning]
warnings Set QName
partialdefs Map OpaqueId OpaqueBlock
oblocks Map QName OpaqueId
onames) = do
Hash
-> Text
-> FileType
-> [(TopLevelModuleName, Hash)]
-> ModuleName
-> TopLevelModuleName
-> Map ModuleName Scope
-> ScopeInfo
-> Signature
-> RemoteMetaStore
-> DisplayForms
-> Map QName Text
-> Maybe Text
-> BuiltinThings (PrimitiveId, QName)
-> Map [Char] ForeignCodeStack
-> HighlightingInfo
-> [OptionsPragma]
-> [OptionsPragma]
-> PragmaOptions
-> PatternSynDefns
-> [TCWarning]
-> Set QName
-> Map OpaqueId OpaqueBlock
-> Map QName OpaqueId
-> Interface
Interface Hash
h Text
s FileType
ft [(TopLevelModuleName, Hash)]
ms ModuleName
mod TopLevelModuleName
tlmod Map ModuleName Scope
scope ScopeInfo
inside
(Signature
-> RemoteMetaStore
-> DisplayForms
-> Map QName Text
-> Maybe Text
-> BuiltinThings (PrimitiveId, QName)
-> Map [Char] ForeignCodeStack
-> HighlightingInfo
-> [OptionsPragma]
-> [OptionsPragma]
-> PragmaOptions
-> PatternSynDefns
-> [TCWarning]
-> Set QName
-> Map OpaqueId OpaqueBlock
-> Map QName OpaqueId
-> Interface)
-> ReduceM Signature
-> ReduceM
(RemoteMetaStore
-> DisplayForms
-> Map QName Text
-> Maybe Text
-> BuiltinThings (PrimitiveId, QName)
-> Map [Char] ForeignCodeStack
-> HighlightingInfo
-> [OptionsPragma]
-> [OptionsPragma]
-> PragmaOptions
-> PatternSynDefns
-> [TCWarning]
-> Set QName
-> Map OpaqueId OpaqueBlock
-> Map QName OpaqueId
-> Interface)
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> Signature -> ReduceM Signature
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' Signature
sig
ReduceM
(RemoteMetaStore
-> DisplayForms
-> Map QName Text
-> Maybe Text
-> BuiltinThings (PrimitiveId, QName)
-> Map [Char] ForeignCodeStack
-> HighlightingInfo
-> [OptionsPragma]
-> [OptionsPragma]
-> PragmaOptions
-> PatternSynDefns
-> [TCWarning]
-> Set QName
-> Map OpaqueId OpaqueBlock
-> Map QName OpaqueId
-> Interface)
-> ReduceM RemoteMetaStore
-> ReduceM
(DisplayForms
-> Map QName Text
-> Maybe Text
-> BuiltinThings (PrimitiveId, QName)
-> Map [Char] ForeignCodeStack
-> HighlightingInfo
-> [OptionsPragma]
-> [OptionsPragma]
-> PragmaOptions
-> PatternSynDefns
-> [TCWarning]
-> Set QName
-> Map OpaqueId OpaqueBlock
-> Map QName OpaqueId
-> Interface)
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
<*!> RemoteMetaStore -> ReduceM RemoteMetaStore
forall a. a -> ReduceM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure RemoteMetaStore
forall a. Monoid a => a
mempty
ReduceM
(DisplayForms
-> Map QName Text
-> Maybe Text
-> BuiltinThings (PrimitiveId, QName)
-> Map [Char] ForeignCodeStack
-> HighlightingInfo
-> [OptionsPragma]
-> [OptionsPragma]
-> PragmaOptions
-> PatternSynDefns
-> [TCWarning]
-> Set QName
-> Map OpaqueId OpaqueBlock
-> Map QName OpaqueId
-> Interface)
-> ReduceM DisplayForms
-> ReduceM
(Map QName Text
-> Maybe Text
-> BuiltinThings (PrimitiveId, QName)
-> Map [Char] ForeignCodeStack
-> HighlightingInfo
-> [OptionsPragma]
-> [OptionsPragma]
-> PragmaOptions
-> PatternSynDefns
-> [TCWarning]
-> Set QName
-> Map OpaqueId OpaqueBlock
-> Map QName OpaqueId
-> Interface)
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
<*!> DisplayForms -> ReduceM DisplayForms
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' DisplayForms
display
ReduceM
(Map QName Text
-> Maybe Text
-> BuiltinThings (PrimitiveId, QName)
-> Map [Char] ForeignCodeStack
-> HighlightingInfo
-> [OptionsPragma]
-> [OptionsPragma]
-> PragmaOptions
-> PatternSynDefns
-> [TCWarning]
-> Set QName
-> Map OpaqueId OpaqueBlock
-> Map QName OpaqueId
-> Interface)
-> ReduceM (Map QName Text)
-> ReduceM
(Maybe Text
-> BuiltinThings (PrimitiveId, QName)
-> Map [Char] ForeignCodeStack
-> HighlightingInfo
-> [OptionsPragma]
-> [OptionsPragma]
-> PragmaOptions
-> PatternSynDefns
-> [TCWarning]
-> Set QName
-> Map OpaqueId OpaqueBlock
-> Map QName OpaqueId
-> Interface)
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
<*!> Map QName Text -> ReduceM (Map QName Text)
forall a. a -> ReduceM a
forall (m :: * -> *) a. Monad m => a -> m a
return Map QName Text
userwarn
ReduceM
(Maybe Text
-> BuiltinThings (PrimitiveId, QName)
-> Map [Char] ForeignCodeStack
-> HighlightingInfo
-> [OptionsPragma]
-> [OptionsPragma]
-> PragmaOptions
-> PatternSynDefns
-> [TCWarning]
-> Set QName
-> Map OpaqueId OpaqueBlock
-> Map QName OpaqueId
-> Interface)
-> ReduceM (Maybe Text)
-> ReduceM
(BuiltinThings (PrimitiveId, QName)
-> Map [Char] ForeignCodeStack
-> HighlightingInfo
-> [OptionsPragma]
-> [OptionsPragma]
-> PragmaOptions
-> PatternSynDefns
-> [TCWarning]
-> Set QName
-> Map OpaqueId OpaqueBlock
-> Map QName OpaqueId
-> Interface)
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
<*!> Maybe Text -> ReduceM (Maybe Text)
forall a. a -> ReduceM a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
importwarn
ReduceM
(BuiltinThings (PrimitiveId, QName)
-> Map [Char] ForeignCodeStack
-> HighlightingInfo
-> [OptionsPragma]
-> [OptionsPragma]
-> PragmaOptions
-> PatternSynDefns
-> [TCWarning]
-> Set QName
-> Map OpaqueId OpaqueBlock
-> Map QName OpaqueId
-> Interface)
-> ReduceM (BuiltinThings (PrimitiveId, QName))
-> ReduceM
(Map [Char] ForeignCodeStack
-> HighlightingInfo
-> [OptionsPragma]
-> [OptionsPragma]
-> PragmaOptions
-> PatternSynDefns
-> [TCWarning]
-> Set QName
-> Map OpaqueId OpaqueBlock
-> Map QName OpaqueId
-> Interface)
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
<*!> BuiltinThings (PrimitiveId, QName)
-> ReduceM (BuiltinThings (PrimitiveId, QName))
forall t. InstantiateFull t => t -> ReduceM t
instantiateFull' BuiltinThings (PrimitiveId, QName)
b
ReduceM
(Map [Char] ForeignCodeStack
-> HighlightingInfo
-> [OptionsPragma]
-> [OptionsPragma]
-> PragmaOptions
-> PatternSynDefns
-> [TCWarning]
-> Set QName
-> Map OpaqueId OpaqueBlock
-> Map QName OpaqueId
-> Interface)
-> ReduceM (Map [Char] ForeignCodeStack)
-> ReduceM
(HighlightingInfo
-> [OptionsPragma]
-> [OptionsPragma]
-> PragmaOptions
-> PatternSynDefns
-> [TCWarning]
-> Set QName
-> Map OpaqueId OpaqueBlock
-> Map QName OpaqueId
-> Interface)
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
<*!> Map [Char] ForeignCodeStack
-> ReduceM (Map [Char] ForeignCodeStack)
forall a. a -> ReduceM a
forall (m :: * -> *) a. Monad m => a -> m a
return Map [Char] ForeignCodeStack
foreignCode
ReduceM
(HighlightingInfo
-> [OptionsPragma]
-> [OptionsPragma]
-> PragmaOptions
-> PatternSynDefns
-> [TCWarning]
-> Set QName
-> Map OpaqueId OpaqueBlock
-> Map QName OpaqueId
-> Interface)
-> ReduceM HighlightingInfo
-> ReduceM
([OptionsPragma]
-> [OptionsPragma]
-> PragmaOptions
-> PatternSynDefns
-> [TCWarning]
-> Set QName
-> Map OpaqueId OpaqueBlock
-> Map QName OpaqueId
-> Interface)
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
<*!> HighlightingInfo -> ReduceM HighlightingInfo
forall a. a -> ReduceM a
forall (m :: * -> *) a. Monad m => a -> m a
return HighlightingInfo
highlighting
ReduceM
([OptionsPragma]
-> [OptionsPragma]
-> PragmaOptions
-> PatternSynDefns
-> [TCWarning]
-> Set QName
-> Map OpaqueId OpaqueBlock
-> Map QName OpaqueId
-> Interface)
-> ReduceM [OptionsPragma]
-> ReduceM
([OptionsPragma]
-> PragmaOptions
-> PatternSynDefns
-> [TCWarning]
-> Set QName
-> Map OpaqueId OpaqueBlock
-> Map QName OpaqueId
-> Interface)
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
<*!> [OptionsPragma] -> ReduceM [OptionsPragma]
forall a. a -> ReduceM a
forall (m :: * -> *) a. Monad m => a -> m a
return [OptionsPragma]
libPragmas
ReduceM
([OptionsPragma]
-> PragmaOptions
-> PatternSynDefns
-> [TCWarning]
-> Set QName
-> Map OpaqueId OpaqueBlock
-> Map QName OpaqueId
-> Interface)
-> ReduceM [OptionsPragma]
-> ReduceM
(PragmaOptions
-> PatternSynDefns
-> [TCWarning]
-> Set QName
-> Map OpaqueId OpaqueBlock
-> Map QName OpaqueId
-> Interface)
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
<*!> [OptionsPragma] -> ReduceM [OptionsPragma]
forall a. a -> ReduceM a
forall (m :: * -> *) a. Monad m => a -> m a
return [OptionsPragma]
filePragmas
ReduceM
(PragmaOptions
-> PatternSynDefns
-> [TCWarning]
-> Set QName
-> Map OpaqueId OpaqueBlock
-> Map QName OpaqueId
-> Interface)
-> ReduceM PragmaOptions
-> ReduceM
(PatternSynDefns
-> [TCWarning]
-> Set QName
-> Map OpaqueId OpaqueBlock
-> Map QName OpaqueId
-> Interface)
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
<*!> PragmaOptions -> ReduceM PragmaOptions
forall a. a -> ReduceM a
forall (m :: * -> *) a. Monad m => a -> m a
return PragmaOptions
usedOpts
ReduceM
(PatternSynDefns
-> [TCWarning]
-> Set QName
-> Map OpaqueId OpaqueBlock
-> Map QName OpaqueId
-> Interface)
-> ReduceM PatternSynDefns
-> ReduceM
([TCWarning]
-> Set QName
-> Map OpaqueId OpaqueBlock
-> Map QName OpaqueId
-> Interface)
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
<*!> PatternSynDefns -> ReduceM PatternSynDefns
forall a. a -> ReduceM a
forall (m :: * -> *) a. Monad m => a -> m a
return PatternSynDefns
patsyns
ReduceM
([TCWarning]
-> Set QName
-> Map OpaqueId OpaqueBlock
-> Map QName OpaqueId
-> Interface)
-> ReduceM [TCWarning]
-> ReduceM
(Set QName
-> Map OpaqueId OpaqueBlock -> Map QName OpaqueId -> Interface)
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
<*!> [TCWarning] -> ReduceM [TCWarning]
forall a. a -> ReduceM a
forall (m :: * -> *) a. Monad m => a -> m a
return [TCWarning]
warnings
ReduceM
(Set QName
-> Map OpaqueId OpaqueBlock -> Map QName OpaqueId -> Interface)
-> ReduceM (Set QName)
-> ReduceM
(Map OpaqueId OpaqueBlock -> Map QName OpaqueId -> Interface)
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
<*!> Set QName -> ReduceM (Set QName)
forall a. a -> ReduceM a
forall (m :: * -> *) a. Monad m => a -> m a
return Set QName
partialdefs
ReduceM
(Map OpaqueId OpaqueBlock -> Map QName OpaqueId -> Interface)
-> ReduceM (Map OpaqueId OpaqueBlock)
-> ReduceM (Map QName OpaqueId -> Interface)
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
<*!> Map OpaqueId OpaqueBlock -> ReduceM (Map OpaqueId OpaqueBlock)
forall a. a -> ReduceM a
forall (m :: * -> *) a. Monad m => a -> m a
return Map OpaqueId OpaqueBlock
oblocks
ReduceM (Map QName OpaqueId -> Interface)
-> ReduceM (Map QName OpaqueId) -> ReduceM Interface
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
<*!> Map QName OpaqueId -> ReduceM (Map QName OpaqueId)
forall a. a -> ReduceM a
forall (m :: * -> *) a. Monad m => a -> m a
return Map QName OpaqueId
onames
instance InstantiateFull a => InstantiateFull (Builtin a) where
instantiateFull' :: Builtin a -> ReduceM (Builtin a)
instantiateFull' (Builtin 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 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
instantiateFull' b :: Builtin a
b@(BuiltinRewriteRelations Set QName
xs) = Builtin a -> ReduceM (Builtin a)
forall a. a -> ReduceM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Builtin a
b
instance InstantiateFull Candidate where
instantiateFull' :: Candidate -> ReduceM Candidate
instantiateFull' (Candidate CandidateKind
q Term
u Type
t OverlapMode
ov) =
CandidateKind -> Term -> Type -> OverlapMode -> Candidate
Candidate CandidateKind
q (Term -> Type -> OverlapMode -> Candidate)
-> ReduceM Term -> ReduceM (Type -> OverlapMode -> 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 -> OverlapMode -> Candidate)
-> ReduceM Type -> ReduceM (OverlapMode -> Candidate)
forall a b. ReduceM (a -> b) -> ReduceM a -> ReduceM b
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 (OverlapMode -> Candidate)
-> ReduceM OverlapMode -> ReduceM Candidate
forall a b. ReduceM (a -> b) -> ReduceM a -> ReduceM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> OverlapMode -> ReduceM OverlapMode
forall a. a -> ReduceM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure OverlapMode
ov
instance InstantiateFull EqualityView where
instantiateFull' :: EqualityView -> ReduceM EqualityView
instantiateFull' (OtherType 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' (IdiomType Type
t) = Type -> EqualityView
IdiomType
(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 Sort
s QName
eq [Arg Term]
l Arg Term
t Arg Term
a 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 a b. ReduceM (a -> b) -> ReduceM a -> ReduceM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> QName -> ReduceM QName
forall a. a -> ReduceM a
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 a b. ReduceM (a -> b) -> ReduceM a -> ReduceM b
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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [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 a b. ReduceM (a -> b) -> ReduceM a -> ReduceM b
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 a b. ReduceM (a -> b) -> ReduceM a -> ReduceM b
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 a b. ReduceM (a -> b) -> ReduceM a -> ReduceM b
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