module Agda.TypeChecking.Unquote where

import Control.Arrow          ( first, second, (&&&) )
import Control.Monad          ( (<=<), liftM2 )
import Control.Monad.Except   ( MonadError(..), ExceptT(..), runExceptT )
import Control.Monad.IO.Class ( MonadIO(..) )
import Control.Monad.Reader   ( ReaderT(..), runReaderT, ask )
import Control.Monad.State    ( gets, modify, StateT(..), runStateT )
import Control.Monad.Writer   ( MonadWriter(..), WriterT(..), runWriterT )
import Control.Monad.Trans    ( lift )

import Data.Char
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Maybe (fromMaybe)
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Text (Text)
import qualified Data.Text as T
import Data.Word

import System.Directory (doesFileExist, getPermissions, executable)
import System.Process ( readProcessWithExitCode )
import System.Exit ( ExitCode(..) )

import Agda.Syntax.Common hiding ( Nat )
import Agda.Syntax.Internal as I
import qualified Agda.Syntax.Reflected as R
import qualified Agda.Syntax.Abstract as A
import Agda.Syntax.Abstract.Views
import Agda.Syntax.Translation.InternalToAbstract
import Agda.Syntax.Literal
import Agda.Syntax.Position
import Agda.Syntax.Info
import Agda.Syntax.Translation.ReflectedToAbstract
import Agda.Syntax.Scope.Base (KindOfName(ConName, DataName))

import Agda.Interaction.Library ( ExeName )
import Agda.Interaction.Options ( optTrustedExecutables, optAllowExec )

import Agda.TypeChecking.Constraints
import Agda.TypeChecking.Monad
import Agda.TypeChecking.Free
import Agda.TypeChecking.Irrelevance ( workOnTypes )
import Agda.TypeChecking.Pretty
import Agda.TypeChecking.Reduce
import Agda.TypeChecking.Substitute
import Agda.TypeChecking.Telescope
import Agda.TypeChecking.Quote
import Agda.TypeChecking.Conversion
import Agda.TypeChecking.EtaContract
import Agda.TypeChecking.Primitive
import Agda.TypeChecking.ReconstructParameters
import Agda.TypeChecking.CheckInternal
import Agda.TypeChecking.InstanceArguments ( getInstanceCandidates )

import {-# SOURCE #-} Agda.TypeChecking.Rules.Term
import {-# SOURCE #-} Agda.TypeChecking.Rules.Def
import {-# SOURCE #-} Agda.TypeChecking.Rules.Decl
import Agda.TypeChecking.Rules.Data

import Agda.Utils.Either
import Agda.Utils.Lens
import Agda.Utils.List1 (List1, pattern (:|))
import qualified Agda.Utils.List1 as List1
import Agda.Utils.Monad
import Agda.Utils.Pretty (prettyShow)
import qualified Agda.Interaction.Options.Lenses as Lens

import Agda.Utils.Impossible
import Agda.Syntax.Abstract (TypedBindingInfo(tbTacticAttr))

agdaTermType :: TCM Type
agdaTermType :: TCM Type
agdaTermType = Sort' Term -> Term -> Type
forall t a. Sort' t -> a -> Type'' t a
El (Integer -> Sort' Term
mkType Integer
0) (Term -> Type) -> TCMT IO Term -> TCM Type
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primAgdaTerm

agdaTypeType :: TCM Type
agdaTypeType :: TCM Type
agdaTypeType = TCM Type
agdaTermType

qNameType :: TCM Type
qNameType :: TCM Type
qNameType = Sort' Term -> Term -> Type
forall t a. Sort' t -> a -> Type'' t a
El (Integer -> Sort' Term
mkType Integer
0) (Term -> Type) -> TCMT IO Term -> TCM Type
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primQName

data Dirty = Dirty | Clean
  deriving (Dirty -> Dirty -> Bool
(Dirty -> Dirty -> Bool) -> (Dirty -> Dirty -> Bool) -> Eq Dirty
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Dirty -> Dirty -> Bool
== :: Dirty -> Dirty -> Bool
$c/= :: Dirty -> Dirty -> Bool
/= :: Dirty -> Dirty -> Bool
Eq)

-- Keep track of the original context. We need to use that when adding new
-- definitions. Also state snapshot from last commit and whether the state is
-- dirty (definitions have been added).
type UnquoteState = (Dirty, TCState)
type UnquoteM = ReaderT Context (StateT UnquoteState (WriterT [QName] (ExceptT UnquoteError TCM)))

type UnquoteRes a = Either UnquoteError ((a, UnquoteState), [QName])

unpackUnquoteM :: UnquoteM a -> Context -> UnquoteState -> TCM (UnquoteRes a)
unpackUnquoteM :: forall a.
UnquoteM a -> Context -> UnquoteState -> TCM (UnquoteRes a)
unpackUnquoteM UnquoteM a
m Context
cxt UnquoteState
s = ExceptT UnquoteError (TCMT IO) ((a, UnquoteState), [QName])
-> TCMT IO (Either UnquoteError ((a, UnquoteState), [QName]))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT UnquoteError (TCMT IO) ((a, UnquoteState), [QName])
 -> TCMT IO (Either UnquoteError ((a, UnquoteState), [QName])))
-> ExceptT UnquoteError (TCMT IO) ((a, UnquoteState), [QName])
-> TCMT IO (Either UnquoteError ((a, UnquoteState), [QName]))
forall a b. (a -> b) -> a -> b
$ WriterT [QName] (ExceptT UnquoteError (TCMT IO)) (a, UnquoteState)
-> ExceptT UnquoteError (TCMT IO) ((a, UnquoteState), [QName])
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT (WriterT [QName] (ExceptT UnquoteError (TCMT IO)) (a, UnquoteState)
 -> ExceptT UnquoteError (TCMT IO) ((a, UnquoteState), [QName]))
-> WriterT
     [QName] (ExceptT UnquoteError (TCMT IO)) (a, UnquoteState)
-> ExceptT UnquoteError (TCMT IO) ((a, UnquoteState), [QName])
forall a b. (a -> b) -> a -> b
$ StateT
  UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))) a
-> UnquoteState
-> WriterT
     [QName] (ExceptT UnquoteError (TCMT IO)) (a, UnquoteState)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (UnquoteM a
-> Context
-> StateT
     UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))) a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT UnquoteM a
m Context
cxt) UnquoteState
s

packUnquoteM :: (Context -> UnquoteState -> TCM (UnquoteRes a)) -> UnquoteM a
packUnquoteM :: forall a.
(Context -> UnquoteState -> TCM (UnquoteRes a)) -> UnquoteM a
packUnquoteM Context -> UnquoteState -> TCM (UnquoteRes a)
f = (Context
 -> StateT
      UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))) a)
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     a
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((Context
  -> StateT
       UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))) a)
 -> ReaderT
      Context
      (StateT
         UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
      a)
-> (Context
    -> StateT
         UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))) a)
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     a
forall a b. (a -> b) -> a -> b
$ \ Context
cxt -> (UnquoteState
 -> WriterT
      [QName] (ExceptT UnquoteError (TCMT IO)) (a, UnquoteState))
-> StateT
     UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))) a
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT ((UnquoteState
  -> WriterT
       [QName] (ExceptT UnquoteError (TCMT IO)) (a, UnquoteState))
 -> StateT
      UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))) a)
-> (UnquoteState
    -> WriterT
         [QName] (ExceptT UnquoteError (TCMT IO)) (a, UnquoteState))
-> StateT
     UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))) a
forall a b. (a -> b) -> a -> b
$ \ UnquoteState
s -> ExceptT UnquoteError (TCMT IO) ((a, UnquoteState), [QName])
-> WriterT
     [QName] (ExceptT UnquoteError (TCMT IO)) (a, UnquoteState)
forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
WriterT (ExceptT UnquoteError (TCMT IO) ((a, UnquoteState), [QName])
 -> WriterT
      [QName] (ExceptT UnquoteError (TCMT IO)) (a, UnquoteState))
-> ExceptT UnquoteError (TCMT IO) ((a, UnquoteState), [QName])
-> WriterT
     [QName] (ExceptT UnquoteError (TCMT IO)) (a, UnquoteState)
forall a b. (a -> b) -> a -> b
$ TCM (UnquoteRes a)
-> ExceptT UnquoteError (TCMT IO) ((a, UnquoteState), [QName])
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (TCM (UnquoteRes a)
 -> ExceptT UnquoteError (TCMT IO) ((a, UnquoteState), [QName]))
-> TCM (UnquoteRes a)
-> ExceptT UnquoteError (TCMT IO) ((a, UnquoteState), [QName])
forall a b. (a -> b) -> a -> b
$ Context -> UnquoteState -> TCM (UnquoteRes a)
f Context
cxt UnquoteState
s

runUnquoteM :: UnquoteM a -> TCM (Either UnquoteError (a, [QName]))
runUnquoteM :: forall a. UnquoteM a -> TCM (Either UnquoteError (a, [QName]))
runUnquoteM UnquoteM a
m = do
  Context
cxt <- (TCEnv -> Context) -> TCMT IO Context
forall (m :: * -> *) a. MonadTCEnv m => (TCEnv -> a) -> m a
asksTC TCEnv -> Context
envContext
  TCState
s   <- TCMT IO TCState
forall (m :: * -> *). MonadTCState m => m TCState
getTC
  UnquoteRes a
z   <- UnquoteM a -> Context -> UnquoteState -> TCM (UnquoteRes a)
forall a.
UnquoteM a -> Context -> UnquoteState -> TCM (UnquoteRes a)
unpackUnquoteM UnquoteM a
m Context
cxt (Dirty
Clean, TCState
s)
  case UnquoteRes a
z of
    Left UnquoteError
err              -> Either UnquoteError (a, [QName])
-> TCM (Either UnquoteError (a, [QName]))
forall a. a -> TCMT IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either UnquoteError (a, [QName])
 -> TCM (Either UnquoteError (a, [QName])))
-> Either UnquoteError (a, [QName])
-> TCM (Either UnquoteError (a, [QName]))
forall a b. (a -> b) -> a -> b
$ UnquoteError -> Either UnquoteError (a, [QName])
forall a b. a -> Either a b
Left UnquoteError
err
    Right ((a
x, UnquoteState
_), [QName]
decls) -> (a, [QName]) -> Either UnquoteError (a, [QName])
forall a b. b -> Either a b
Right (a
x, [QName]
decls) Either UnquoteError (a, [QName])
-> TCMT IO () -> TCM (Either UnquoteError (a, [QName]))
forall a b. a -> TCMT IO b -> TCMT IO a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (QName -> TCMT IO ()) -> [QName] -> TCMT IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ QName -> TCMT IO ()
forall {m :: * -> *}.
(HasConstInfo m, ReadTCState m, MonadError TCErr m) =>
QName -> m ()
isDefined [QName]
decls
  where
    isDefined :: QName -> m ()
isDefined QName
x = do
      Defn
def <- Definition -> Defn
theDef (Definition -> Defn) -> m Definition -> m Defn
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> QName -> m Definition
forall (m :: * -> *). HasConstInfo m => QName -> m Definition
getConstInfo QName
x
      case Defn
def of
        Function{funClauses :: Defn -> [Clause]
funClauses = []} -> [Char] -> m ()
forall (m :: * -> *) a.
(HasCallStack, MonadTCError m) =>
[Char] -> m a
genericError ([Char] -> m ()) -> [Char] -> m ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Missing definition for " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ QName -> [Char]
forall a. Pretty a => a -> [Char]
prettyShow QName
x
        Defn
_       -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

liftU1 :: (TCM (UnquoteRes a) -> TCM (UnquoteRes b)) -> UnquoteM a -> UnquoteM b
liftU1 :: forall a b.
(TCM (UnquoteRes a) -> TCM (UnquoteRes b))
-> UnquoteM a -> UnquoteM b
liftU1 TCM (UnquoteRes a) -> TCM (UnquoteRes b)
f UnquoteM a
m = (Context -> UnquoteState -> TCM (UnquoteRes b)) -> UnquoteM b
forall a.
(Context -> UnquoteState -> TCM (UnquoteRes a)) -> UnquoteM a
packUnquoteM ((Context -> UnquoteState -> TCM (UnquoteRes b)) -> UnquoteM b)
-> (Context -> UnquoteState -> TCM (UnquoteRes b)) -> UnquoteM b
forall a b. (a -> b) -> a -> b
$ \ Context
cxt UnquoteState
s -> TCM (UnquoteRes a) -> TCM (UnquoteRes b)
f (UnquoteM a -> Context -> UnquoteState -> TCM (UnquoteRes a)
forall a.
UnquoteM a -> Context -> UnquoteState -> TCM (UnquoteRes a)
unpackUnquoteM UnquoteM a
m Context
cxt UnquoteState
s)

liftU2 :: (TCM (UnquoteRes a) -> TCM (UnquoteRes b) -> TCM (UnquoteRes c)) -> UnquoteM a -> UnquoteM b -> UnquoteM c
liftU2 :: forall a b c.
(TCM (UnquoteRes a) -> TCM (UnquoteRes b) -> TCM (UnquoteRes c))
-> UnquoteM a -> UnquoteM b -> UnquoteM c
liftU2 TCM (UnquoteRes a) -> TCM (UnquoteRes b) -> TCM (UnquoteRes c)
f UnquoteM a
m1 UnquoteM b
m2 = (Context -> UnquoteState -> TCM (UnquoteRes c)) -> UnquoteM c
forall a.
(Context -> UnquoteState -> TCM (UnquoteRes a)) -> UnquoteM a
packUnquoteM ((Context -> UnquoteState -> TCM (UnquoteRes c)) -> UnquoteM c)
-> (Context -> UnquoteState -> TCM (UnquoteRes c)) -> UnquoteM c
forall a b. (a -> b) -> a -> b
$ \ Context
cxt UnquoteState
s -> TCM (UnquoteRes a) -> TCM (UnquoteRes b) -> TCM (UnquoteRes c)
f (UnquoteM a -> Context -> UnquoteState -> TCM (UnquoteRes a)
forall a.
UnquoteM a -> Context -> UnquoteState -> TCM (UnquoteRes a)
unpackUnquoteM UnquoteM a
m1 Context
cxt UnquoteState
s) (UnquoteM b -> Context -> UnquoteState -> TCM (UnquoteRes b)
forall a.
UnquoteM a -> Context -> UnquoteState -> TCM (UnquoteRes a)
unpackUnquoteM UnquoteM b
m2 Context
cxt UnquoteState
s)

inOriginalContext :: UnquoteM a -> UnquoteM a
inOriginalContext :: forall a. UnquoteM a -> UnquoteM a
inOriginalContext UnquoteM a
m =
  (Context -> UnquoteState -> TCM (UnquoteRes a)) -> UnquoteM a
forall a.
(Context -> UnquoteState -> TCM (UnquoteRes a)) -> UnquoteM a
packUnquoteM ((Context -> UnquoteState -> TCM (UnquoteRes a)) -> UnquoteM a)
-> (Context -> UnquoteState -> TCM (UnquoteRes a)) -> UnquoteM a
forall a b. (a -> b) -> a -> b
$ \ Context
cxt UnquoteState
s -> do
    Int
n <- TCMT IO Int
forall (m :: * -> *). (Applicative m, MonadTCEnv m) => m Int
getContextSize
    Impossible -> Int -> TCM (UnquoteRes a) -> TCM (UnquoteRes a)
forall (m :: * -> *) a.
MonadAddContext m =>
Impossible -> Int -> m a -> m a
escapeContext Impossible
forall a. HasCallStack => a
__IMPOSSIBLE__ (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Context -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Context
cxt) (TCM (UnquoteRes a) -> TCM (UnquoteRes a))
-> TCM (UnquoteRes a) -> TCM (UnquoteRes a)
forall a b. (a -> b) -> a -> b
$ UnquoteM a -> Context -> UnquoteState -> TCM (UnquoteRes a)
forall a.
UnquoteM a -> Context -> UnquoteState -> TCM (UnquoteRes a)
unpackUnquoteM UnquoteM a
m Context
cxt UnquoteState
s

isCon :: ConHead -> TCM Term -> UnquoteM Bool
isCon :: ConHead -> TCMT IO Term -> UnquoteM Bool
isCon ConHead
con TCMT IO Term
tm = do Term
t <- TCMT IO Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
forall a.
TCM a
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     a
forall (tcm :: * -> *) a. MonadTCM tcm => TCM a -> tcm a
liftTCM TCMT IO Term
tm
                  case Term
t of
                    Con ConHead
con' ConInfo
_ Elims
_ -> Bool -> UnquoteM Bool
forall a.
a
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     a
forall (m :: * -> *) a. Monad m => a -> m a
return (ConHead
con ConHead -> ConHead -> Bool
forall a. Eq a => a -> a -> Bool
== ConHead
con')
                    Term
_ -> Bool -> UnquoteM Bool
forall a.
a
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False

isDef :: QName -> TCM Term -> UnquoteM Bool
isDef :: QName -> TCMT IO Term -> UnquoteM Bool
isDef QName
f TCMT IO Term
tm = Term -> Bool
loop (Term -> Bool)
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
-> UnquoteM Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TCMT IO Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
forall a.
TCM a
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     a
forall (tcm :: * -> *) a. MonadTCM tcm => TCM a -> tcm a
liftTCM TCMT IO Term
tm
  where
    loop :: Term -> Bool
loop (Def QName
g Elims
_) = QName
f QName -> QName -> Bool
forall a. Eq a => a -> a -> Bool
== QName
g
    loop (Lam ArgInfo
_ Abs Term
b) = Term -> Bool
loop (Term -> Bool) -> Term -> Bool
forall a b. (a -> b) -> a -> b
$ Abs Term -> Term
forall a. Abs a -> a
unAbs Abs Term
b
    loop Term
_         = Bool
False

reduceQuotedTerm :: Term -> UnquoteM Term
reduceQuotedTerm :: Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
reduceQuotedTerm Term
t = ReaderT
  Context
  (StateT
     UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
  Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
forall (m :: * -> *) a. MonadTCEnv m => m a -> m a
locallyReduceAllDefs (ReaderT
   Context
   (StateT
      UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
   Term
 -> ReaderT
      Context
      (StateT
         UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
      Term)
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
forall a b. (a -> b) -> a -> b
$ do
  Term
-> (Blocker
    -> Term
    -> ReaderT
         Context
         (StateT
            UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
         Term)
-> (NotBlocked
    -> Term
    -> ReaderT
         Context
         (StateT
            UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
         Term)
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
forall t (m :: * -> *) a.
(Reduce t, IsMeta t, MonadReduce m) =>
t -> (Blocker -> t -> m a) -> (NotBlocked -> t -> m a) -> m a
ifBlocked Term
t {-then-} (\ Blocker
m Term
_ -> do TCState
s <- (UnquoteState -> TCState)
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     TCState
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets UnquoteState -> TCState
forall a b. (a, b) -> b
snd; UnquoteError
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
forall a.
UnquoteError
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (UnquoteError
 -> ReaderT
      Context
      (StateT
         UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
      Term)
-> UnquoteError
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
forall a b. (a -> b) -> a -> b
$ TCState -> Blocker -> UnquoteError
BlockedOnMeta TCState
s Blocker
m)
              {-else-} (\ NotBlocked
_ Term
t -> Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
forall a.
a
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     a
forall (m :: * -> *) a. Monad m => a -> m a
return Term
t)

class Unquote a where
  unquote :: I.Term -> UnquoteM a

unquoteN :: Unquote a => Arg Term -> UnquoteM a
unquoteN :: forall a. Unquote a => Arg Term -> UnquoteM a
unquoteN 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 =
    Term -> UnquoteM a
forall a. Unquote a => Term -> UnquoteM a
unquote (Term -> UnquoteM a) -> Term -> UnquoteM a
forall a b. (a -> b) -> a -> b
$ Arg Term -> Term
forall e. Arg e -> e
unArg Arg Term
a
unquoteN Arg Term
a = UnquoteError -> UnquoteM a
forall a.
UnquoteError
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (UnquoteError -> UnquoteM a) -> UnquoteError -> UnquoteM a
forall a b. (a -> b) -> a -> b
$ [Char] -> Arg Term -> UnquoteError
BadVisibility [Char]
"visible" Arg Term
a

choice :: Monad m => [(m Bool, m a)] -> m a -> m a
choice :: forall (m :: * -> *) a. Monad m => [(m Bool, m a)] -> m a -> m a
choice [] m a
dflt = m a
dflt
choice ((m Bool
mb, m a
mx) : [(m Bool, m a)]
mxs) m a
dflt = m Bool -> m a -> m a -> m a
forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifM m Bool
mb m a
mx (m a -> m a) -> m a -> m a
forall a b. (a -> b) -> a -> b
$ [(m Bool, m a)] -> m a -> m a
forall (m :: * -> *) a. Monad m => [(m Bool, m a)] -> m a -> m a
choice [(m Bool, m a)]
mxs m a
dflt

ensureDef :: QName -> UnquoteM QName
ensureDef :: QName -> UnquoteM QName
ensureDef QName
x = do
  Defn
i <- (SigError -> Defn)
-> (Definition -> Defn) -> Either SigError Definition -> Defn
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Defn -> SigError -> Defn
forall a b. a -> b -> a
const Defn
defaultAxiom) Definition -> Defn
theDef (Either SigError Definition -> Defn)
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     (Either SigError Definition)
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Defn
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> QName
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     (Either SigError Definition)
forall (m :: * -> *).
HasConstInfo m =>
QName -> m (Either SigError Definition)
getConstInfo' QName
x  -- for recursive unquoteDecl
  case Defn
i of
    Constructor{} -> do
      Doc
def <- TCMT IO Doc
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Doc
forall a.
TCM a
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     a
forall (tcm :: * -> *) a. MonadTCM tcm => TCM a -> tcm a
liftTCM (TCMT IO Doc
 -> ReaderT
      Context
      (StateT
         UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
      Doc)
-> TCMT IO Doc
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Doc
forall a b. (a -> b) -> a -> b
$ Term -> TCMT IO Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
forall (m :: * -> *). MonadPretty m => Term -> m Doc
prettyTCM (Term -> TCMT IO Doc) -> TCMT IO Term -> TCMT IO Doc
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primAgdaTermDef
      Doc
con <- TCMT IO Doc
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Doc
forall a.
TCM a
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     a
forall (tcm :: * -> *) a. MonadTCM tcm => TCM a -> tcm a
liftTCM (TCMT IO Doc
 -> ReaderT
      Context
      (StateT
         UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
      Doc)
-> TCMT IO Doc
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Doc
forall a b. (a -> b) -> a -> b
$ Term -> TCMT IO Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
forall (m :: * -> *). MonadPretty m => Term -> m Doc
prettyTCM (Term -> TCMT IO Doc) -> TCMT IO Term -> TCMT IO Doc
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primAgdaTermCon
      UnquoteError -> UnquoteM QName
forall a.
UnquoteError
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (UnquoteError -> UnquoteM QName) -> UnquoteError -> UnquoteM QName
forall a b. (a -> b) -> a -> b
$ QName -> [Char] -> [Char] -> UnquoteError
ConInsteadOfDef QName
x (Doc -> [Char]
forall a. Show a => a -> [Char]
show Doc
def) (Doc -> [Char]
forall a. Show a => a -> [Char]
show Doc
con)
    Defn
_ -> QName -> UnquoteM QName
forall a.
a
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     a
forall (m :: * -> *) a. Monad m => a -> m a
return QName
x

ensureCon :: QName -> UnquoteM QName
ensureCon :: QName -> UnquoteM QName
ensureCon QName
x = do
  Defn
i <- (SigError -> Defn)
-> (Definition -> Defn) -> Either SigError Definition -> Defn
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Defn -> SigError -> Defn
forall a b. a -> b -> a
const Defn
defaultAxiom) Definition -> Defn
theDef (Either SigError Definition -> Defn)
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     (Either SigError Definition)
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Defn
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> QName
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     (Either SigError Definition)
forall (m :: * -> *).
HasConstInfo m =>
QName -> m (Either SigError Definition)
getConstInfo' QName
x  -- for recursive unquoteDecl
  case Defn
i of
    Constructor{} -> QName -> UnquoteM QName
forall a.
a
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     a
forall (m :: * -> *) a. Monad m => a -> m a
return QName
x
    Defn
_ -> do
      Doc
def <- TCMT IO Doc
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Doc
forall a.
TCM a
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     a
forall (tcm :: * -> *) a. MonadTCM tcm => TCM a -> tcm a
liftTCM (TCMT IO Doc
 -> ReaderT
      Context
      (StateT
         UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
      Doc)
-> TCMT IO Doc
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Doc
forall a b. (a -> b) -> a -> b
$ Term -> TCMT IO Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
forall (m :: * -> *). MonadPretty m => Term -> m Doc
prettyTCM (Term -> TCMT IO Doc) -> TCMT IO Term -> TCMT IO Doc
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primAgdaTermDef
      Doc
con <- TCMT IO Doc
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Doc
forall a.
TCM a
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     a
forall (tcm :: * -> *) a. MonadTCM tcm => TCM a -> tcm a
liftTCM (TCMT IO Doc
 -> ReaderT
      Context
      (StateT
         UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
      Doc)
-> TCMT IO Doc
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Doc
forall a b. (a -> b) -> a -> b
$ Term -> TCMT IO Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
forall (m :: * -> *). MonadPretty m => Term -> m Doc
prettyTCM (Term -> TCMT IO Doc) -> TCMT IO Term -> TCMT IO Doc
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primAgdaTermCon
      UnquoteError -> UnquoteM QName
forall a.
UnquoteError
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (UnquoteError -> UnquoteM QName) -> UnquoteError -> UnquoteM QName
forall a b. (a -> b) -> a -> b
$ QName -> [Char] -> [Char] -> UnquoteError
DefInsteadOfCon QName
x (Doc -> [Char]
forall a. Show a => a -> [Char]
show Doc
def) (Doc -> [Char]
forall a. Show a => a -> [Char]
show Doc
con)

pickName :: R.Type -> String
pickName :: Type -> [Char]
pickName Type
a =
  case Type
a of
    R.Pi{}   -> [Char]
"f"
    R.Sort{} -> [Char]
"A"
    R.Def QName
d Elims
_
      | Char
c : [Char]
cs  <- Name -> [Char]
forall a. Pretty a => a -> [Char]
prettyShow (QName -> Name
qnameName QName
d),
        Just Char
lc <- Char -> Maybe Char
reallyToLower Char
c,
        Bool -> Bool
not ([Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
cs) Bool -> Bool -> Bool
|| Char -> Bool
isUpper Char
c -> [Char
lc]
    Type
_        -> [Char]
"_"
  where
    -- Heuristic (see #5048 for some discussion):
    -- If first character can be `toLower`ed use that, unless the name has only one character and is
    -- already lower case. (to avoid using the same name for the type and the bound variable).
    reallyToLower :: Char -> Maybe Char
reallyToLower Char
c
      | Char -> Char
toUpper Char
lc Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
lc = Char -> Maybe Char
forall a. a -> Maybe a
Just Char
lc
      | Bool
otherwise        = Maybe Char
forall a. Maybe a
Nothing
      where lc :: Char
lc = Char -> Char
toLower Char
c

-- TODO: reflect Cohesion
instance Unquote Modality where
  unquote :: Term -> UnquoteM Modality
unquote Term
t = do
    Term
t <- Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
reduceQuotedTerm Term
t
    case Term
t of
      Con ConHead
c ConInfo
_ Elims
es | Just [Arg Term
r,Arg Term
q] <- Elims -> Maybe [Arg Term]
forall a. [Elim' a] -> Maybe [Arg a]
allApplyElims Elims
es ->
        [(UnquoteM Bool, UnquoteM Modality)]
-> UnquoteM Modality -> UnquoteM Modality
forall (m :: * -> *) a. Monad m => [(m Bool, m a)] -> m a -> m a
choice
          [(ConHead
c ConHead -> TCMT IO Term -> UnquoteM Bool
`isCon` TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primModalityConstructor,
              Relevance -> Quantity -> Cohesion -> Modality
Modality (Relevance -> Quantity -> Cohesion -> Modality)
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Relevance
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     (Quantity -> Cohesion -> Modality)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Arg Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Relevance
forall a. Unquote a => Arg Term -> UnquoteM a
unquoteN Arg Term
r
                       ReaderT
  Context
  (StateT
     UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
  (Quantity -> Cohesion -> Modality)
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Quantity
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     (Cohesion -> Modality)
forall a b.
ReaderT
  Context
  (StateT
     UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
  (a -> b)
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     a
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Arg Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Quantity
forall a. Unquote a => Arg Term -> UnquoteM a
unquoteN Arg Term
q
                       ReaderT
  Context
  (StateT
     UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
  (Cohesion -> Modality)
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Cohesion
-> UnquoteM Modality
forall a b.
ReaderT
  Context
  (StateT
     UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
  (a -> b)
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     a
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Cohesion
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Cohesion
forall a.
a
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Cohesion
defaultCohesion)]
          UnquoteM Modality
forall a. HasCallStack => a
__IMPOSSIBLE__
      Con ConHead
c ConInfo
_ Elims
_ -> UnquoteM Modality
forall a. HasCallStack => a
__IMPOSSIBLE__
      Term
_ -> UnquoteError -> UnquoteM Modality
forall a.
UnquoteError
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (UnquoteError -> UnquoteM Modality)
-> UnquoteError -> UnquoteM Modality
forall a b. (a -> b) -> a -> b
$ [Char] -> Term -> UnquoteError
NonCanonical [Char]
"modality" Term
t

instance Unquote ArgInfo where
  unquote :: Term -> UnquoteM ArgInfo
unquote Term
t = do
    Term
t <- Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
reduceQuotedTerm Term
t
    case Term
t of
      Con ConHead
c ConInfo
_ Elims
es | Just [Arg Term
h,Arg Term
m] <- Elims -> Maybe [Arg Term]
forall a. [Elim' a] -> Maybe [Arg a]
allApplyElims Elims
es ->
        [(UnquoteM Bool, UnquoteM ArgInfo)]
-> UnquoteM ArgInfo -> UnquoteM ArgInfo
forall (m :: * -> *) a. Monad m => [(m Bool, m a)] -> m a -> m a
choice
          [(ConHead
c ConHead -> TCMT IO Term -> UnquoteM Bool
`isCon` TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primArgArgInfo,
              Hiding
-> Modality -> Origin -> FreeVariables -> Annotation -> ArgInfo
ArgInfo (Hiding
 -> Modality -> Origin -> FreeVariables -> Annotation -> ArgInfo)
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Hiding
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     (Modality -> Origin -> FreeVariables -> Annotation -> ArgInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Arg Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Hiding
forall a. Unquote a => Arg Term -> UnquoteM a
unquoteN Arg Term
h
                      ReaderT
  Context
  (StateT
     UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
  (Modality -> Origin -> FreeVariables -> Annotation -> ArgInfo)
-> UnquoteM Modality
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     (Origin -> FreeVariables -> Annotation -> ArgInfo)
forall a b.
ReaderT
  Context
  (StateT
     UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
  (a -> b)
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     a
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Arg Term -> UnquoteM Modality
forall a. Unquote a => Arg Term -> UnquoteM a
unquoteN Arg Term
m
                      ReaderT
  Context
  (StateT
     UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
  (Origin -> FreeVariables -> Annotation -> ArgInfo)
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Origin
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     (FreeVariables -> Annotation -> ArgInfo)
forall a b.
ReaderT
  Context
  (StateT
     UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
  (a -> b)
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     a
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Origin
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Origin
forall a.
a
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Origin
Reflected
                      ReaderT
  Context
  (StateT
     UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
  (FreeVariables -> Annotation -> ArgInfo)
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     FreeVariables
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     (Annotation -> ArgInfo)
forall a b.
ReaderT
  Context
  (StateT
     UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
  (a -> b)
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     a
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FreeVariables
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     FreeVariables
forall a.
a
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FreeVariables
unknownFreeVariables
                      ReaderT
  Context
  (StateT
     UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
  (Annotation -> ArgInfo)
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Annotation
-> UnquoteM ArgInfo
forall a b.
ReaderT
  Context
  (StateT
     UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
  (a -> b)
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     a
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Annotation
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Annotation
forall a.
a
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Annotation
defaultAnnotation)]
          UnquoteM ArgInfo
forall a. HasCallStack => a
__IMPOSSIBLE__
      Con ConHead
c ConInfo
_ Elims
_ -> UnquoteM ArgInfo
forall a. HasCallStack => a
__IMPOSSIBLE__
      Term
_ -> UnquoteError -> UnquoteM ArgInfo
forall a.
UnquoteError
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (UnquoteError -> UnquoteM ArgInfo)
-> UnquoteError -> UnquoteM ArgInfo
forall a b. (a -> b) -> a -> b
$ [Char] -> Term -> UnquoteError
NonCanonical [Char]
"arg info" Term
t

instance Unquote a => Unquote (Arg a) where
  unquote :: Term -> UnquoteM (Arg a)
unquote Term
t = do
    Term
t <- Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
reduceQuotedTerm Term
t
    case Term
t of
      Con ConHead
c ConInfo
_ Elims
es | Just [Arg Term
info,Arg Term
x] <- Elims -> Maybe [Arg Term]
forall a. [Elim' a] -> Maybe [Arg a]
allApplyElims Elims
es ->
        [(UnquoteM Bool, UnquoteM (Arg a))]
-> UnquoteM (Arg a) -> UnquoteM (Arg a)
forall (m :: * -> *) a. Monad m => [(m Bool, m a)] -> m a -> m a
choice
          [(ConHead
c ConHead -> TCMT IO Term -> UnquoteM Bool
`isCon` TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primArgArg, ArgInfo -> a -> Arg a
forall e. ArgInfo -> e -> Arg e
Arg (ArgInfo -> a -> Arg a)
-> UnquoteM ArgInfo
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     (a -> Arg a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Arg Term -> UnquoteM ArgInfo
forall a. Unquote a => Arg Term -> UnquoteM a
unquoteN Arg Term
info ReaderT
  Context
  (StateT
     UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
  (a -> Arg a)
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     a
-> UnquoteM (Arg a)
forall a b.
ReaderT
  Context
  (StateT
     UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
  (a -> b)
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     a
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Arg Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     a
forall a. Unquote a => Arg Term -> UnquoteM a
unquoteN Arg Term
x)]
          UnquoteM (Arg a)
forall a. HasCallStack => a
__IMPOSSIBLE__
      Con ConHead
c ConInfo
_ Elims
_ -> UnquoteM (Arg a)
forall a. HasCallStack => a
__IMPOSSIBLE__
      Term
_ -> UnquoteError -> UnquoteM (Arg a)
forall a.
UnquoteError
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (UnquoteError -> UnquoteM (Arg a))
-> UnquoteError -> UnquoteM (Arg a)
forall a b. (a -> b) -> a -> b
$ [Char] -> Term -> UnquoteError
NonCanonical [Char]
"arg" Term
t

-- Andreas, 2013-10-20: currently, post-fix projections are not part of the
-- quoted syntax.
instance Unquote R.Elim where
  unquote :: Term -> UnquoteM Elim
unquote Term
t = Arg Type -> Elim
forall a. Arg a -> Elim' a
R.Apply (Arg Type -> Elim)
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     (Arg Type)
-> UnquoteM Elim
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     (Arg Type)
forall a. Unquote a => Term -> UnquoteM a
unquote Term
t

instance Unquote Bool where
  unquote :: Term -> UnquoteM Bool
unquote Term
t = do
    Term
t <- Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
reduceQuotedTerm Term
t
    case Term
t of
      Con ConHead
c ConInfo
_ [] ->
        [(UnquoteM Bool, UnquoteM Bool)] -> UnquoteM Bool -> UnquoteM Bool
forall (m :: * -> *) a. Monad m => [(m Bool, m a)] -> m a -> m a
choice [ (ConHead
c ConHead -> TCMT IO Term -> UnquoteM Bool
`isCon` TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primTrue,  Bool -> UnquoteM Bool
forall a.
a
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True)
               , (ConHead
c ConHead -> TCMT IO Term -> UnquoteM Bool
`isCon` TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primFalse, Bool -> UnquoteM Bool
forall a.
a
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False) ]
               UnquoteM Bool
forall a. HasCallStack => a
__IMPOSSIBLE__
      Term
_ -> UnquoteError -> UnquoteM Bool
forall a.
UnquoteError
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (UnquoteError -> UnquoteM Bool) -> UnquoteError -> UnquoteM Bool
forall a b. (a -> b) -> a -> b
$ [Char] -> Term -> UnquoteError
NonCanonical [Char]
"boolean" Term
t

instance Unquote Integer where
  unquote :: Term -> UnquoteM Integer
unquote Term
t = do
    Term
t <- Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
reduceQuotedTerm Term
t
    case Term
t of
      Lit (LitNat Integer
n) -> Integer -> UnquoteM Integer
forall a.
a
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     a
forall (m :: * -> *) a. Monad m => a -> m a
return Integer
n
      Term
_ -> UnquoteError -> UnquoteM Integer
forall a.
UnquoteError
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (UnquoteError -> UnquoteM Integer)
-> UnquoteError -> UnquoteM Integer
forall a b. (a -> b) -> a -> b
$ [Char] -> Term -> UnquoteError
NonCanonical [Char]
"integer" Term
t

instance Unquote Word64 where
  unquote :: Term -> UnquoteM Word64
unquote Term
t = do
    Term
t <- Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
reduceQuotedTerm Term
t
    case Term
t of
      Lit (LitWord64 Word64
n) -> Word64 -> UnquoteM Word64
forall a.
a
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     a
forall (m :: * -> *) a. Monad m => a -> m a
return Word64
n
      Term
_ -> UnquoteError -> UnquoteM Word64
forall a.
UnquoteError
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (UnquoteError -> UnquoteM Word64)
-> UnquoteError -> UnquoteM Word64
forall a b. (a -> b) -> a -> b
$ [Char] -> Term -> UnquoteError
NonCanonical [Char]
"word64" Term
t

instance Unquote Double where
  unquote :: Term -> UnquoteM Double
unquote Term
t = do
    Term
t <- Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
reduceQuotedTerm Term
t
    case Term
t of
      Lit (LitFloat Double
x) -> Double -> UnquoteM Double
forall a.
a
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     a
forall (m :: * -> *) a. Monad m => a -> m a
return Double
x
      Term
_ -> UnquoteError -> UnquoteM Double
forall a.
UnquoteError
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (UnquoteError -> UnquoteM Double)
-> UnquoteError -> UnquoteM Double
forall a b. (a -> b) -> a -> b
$ [Char] -> Term -> UnquoteError
NonCanonical [Char]
"float" Term
t

instance Unquote Char where
  unquote :: Term -> UnquoteM Char
unquote Term
t = do
    Term
t <- Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
reduceQuotedTerm Term
t
    case Term
t of
      Lit (LitChar Char
x) -> Char -> UnquoteM Char
forall a.
a
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
x
      Term
_ -> UnquoteError -> UnquoteM Char
forall a.
UnquoteError
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (UnquoteError -> UnquoteM Char) -> UnquoteError -> UnquoteM Char
forall a b. (a -> b) -> a -> b
$ [Char] -> Term -> UnquoteError
NonCanonical [Char]
"char" Term
t

instance Unquote Text where
  unquote :: Term -> UnquoteM ExeName
unquote Term
t = do
    Term
t <- Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
reduceQuotedTerm Term
t
    case Term
t of
      Lit (LitString ExeName
x) -> ExeName -> UnquoteM ExeName
forall a.
a
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     a
forall (m :: * -> *) a. Monad m => a -> m a
return ExeName
x
      Term
_ -> UnquoteError -> UnquoteM ExeName
forall a.
UnquoteError
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (UnquoteError -> UnquoteM ExeName)
-> UnquoteError -> UnquoteM ExeName
forall a b. (a -> b) -> a -> b
$ [Char] -> Term -> UnquoteError
NonCanonical [Char]
"string" Term
t

unquoteString :: Term -> UnquoteM String
unquoteString :: Term -> UnquoteM [Char]
unquoteString Term
x = ExeName -> [Char]
T.unpack (ExeName -> [Char]) -> UnquoteM ExeName -> UnquoteM [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term -> UnquoteM ExeName
forall a. Unquote a => Term -> UnquoteM a
unquote Term
x

unquoteNString :: Arg Term -> UnquoteM Text
unquoteNString :: Arg Term -> UnquoteM ExeName
unquoteNString = Arg Term -> UnquoteM ExeName
forall a. Unquote a => Arg Term -> UnquoteM a
unquoteN

data ErrorPart = StrPart String | TermPart A.Expr | PattPart A.Pattern | NamePart QName

instance PrettyTCM ErrorPart where
  prettyTCM :: forall (m :: * -> *). MonadPretty m => ErrorPart -> m Doc
prettyTCM (StrPart [Char]
s)  = [Char] -> m Doc
forall (m :: * -> *). Applicative m => [Char] -> m Doc
text [Char]
s
  prettyTCM (TermPart Expr
t) = Expr -> m Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
forall (m :: * -> *). MonadPretty m => Expr -> m Doc
prettyTCM Expr
t
  prettyTCM (PattPart Pattern
p) = Pattern -> m Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
forall (m :: * -> *). MonadPretty m => Pattern -> m Doc
prettyTCM Pattern
p
  prettyTCM (NamePart QName
x) = QName -> m Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
forall (m :: * -> *). MonadPretty m => QName -> m Doc
prettyTCM QName
x

-- | We do a little bit of work here to make it possible to generate nice
--   layout for multi-line error messages. Specifically we split the parts
--   into lines (indicated by \n in a string part) and vcat all the lines.
prettyErrorParts :: [ErrorPart] -> TCM Doc
prettyErrorParts :: [ErrorPart] -> TCMT IO Doc
prettyErrorParts = [TCMT IO Doc] -> TCMT IO Doc
forall (m :: * -> *) (t :: * -> *).
(Applicative m, Foldable t) =>
t (m Doc) -> m Doc
vcat ([TCMT IO Doc] -> TCMT IO Doc)
-> ([ErrorPart] -> [TCMT IO Doc]) -> [ErrorPart] -> TCMT IO Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([ErrorPart] -> TCMT IO Doc) -> [[ErrorPart]] -> [TCMT IO Doc]
forall a b. (a -> b) -> [a] -> [b]
map ([TCMT IO Doc] -> TCMT IO Doc
forall (m :: * -> *) (t :: * -> *).
(Applicative m, Foldable t) =>
t (m Doc) -> m Doc
hcat ([TCMT IO Doc] -> TCMT IO Doc)
-> ([ErrorPart] -> [TCMT IO Doc]) -> [ErrorPart] -> TCMT IO Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ErrorPart -> TCMT IO Doc) -> [ErrorPart] -> [TCMT IO Doc]
forall a b. (a -> b) -> [a] -> [b]
map ErrorPart -> TCMT IO Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
forall (m :: * -> *). MonadPretty m => ErrorPart -> m Doc
prettyTCM) ([[ErrorPart]] -> [TCMT IO Doc])
-> ([ErrorPart] -> [[ErrorPart]]) -> [ErrorPart] -> [TCMT IO Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ErrorPart] -> [[ErrorPart]]
splitLines
  where
    splitLines :: [ErrorPart] -> [[ErrorPart]]
splitLines [] = []
    splitLines (StrPart [Char]
s : [ErrorPart]
ss) =
      case (Char -> Bool) -> [Char] -> ([Char], [Char])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'\n') [Char]
s of
        ([Char]
s0, Char
'\n' : [Char]
s1) -> [[Char] -> ErrorPart
StrPart [Char]
s0] [ErrorPart] -> [[ErrorPart]] -> [[ErrorPart]]
forall a. a -> [a] -> [a]
: [ErrorPart] -> [[ErrorPart]]
splitLines ([Char] -> ErrorPart
StrPart [Char]
s1 ErrorPart -> [ErrorPart] -> [ErrorPart]
forall a. a -> [a] -> [a]
: [ErrorPart]
ss)
        ([Char]
s0, [Char]
"")        -> ErrorPart -> [[ErrorPart]] -> [[ErrorPart]]
forall {a}. a -> [[a]] -> [[a]]
consLine ([Char] -> ErrorPart
StrPart [Char]
s0) ([ErrorPart] -> [[ErrorPart]]
splitLines [ErrorPart]
ss)
        ([Char], [Char])
_               -> [[ErrorPart]]
forall a. HasCallStack => a
__IMPOSSIBLE__
    splitLines (p :: ErrorPart
p@TermPart{} : [ErrorPart]
ss) = ErrorPart -> [[ErrorPart]] -> [[ErrorPart]]
forall {a}. a -> [[a]] -> [[a]]
consLine ErrorPart
p ([ErrorPart] -> [[ErrorPart]]
splitLines [ErrorPart]
ss)
    splitLines (p :: ErrorPart
p@PattPart{} : [ErrorPart]
ss) = ErrorPart -> [[ErrorPart]] -> [[ErrorPart]]
forall {a}. a -> [[a]] -> [[a]]
consLine ErrorPart
p ([ErrorPart] -> [[ErrorPart]]
splitLines [ErrorPart]
ss)
    splitLines (p :: ErrorPart
p@NamePart{} : [ErrorPart]
ss) = ErrorPart -> [[ErrorPart]] -> [[ErrorPart]]
forall {a}. a -> [[a]] -> [[a]]
consLine ErrorPart
p ([ErrorPart] -> [[ErrorPart]]
splitLines [ErrorPart]
ss)

    consLine :: a -> [[a]] -> [[a]]
consLine a
l []        = [[a
l]]
    consLine a
l ([a]
l' : [[a]]
ls) = (a
l a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
l') [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: [[a]]
ls


instance Unquote ErrorPart where
  unquote :: Term -> UnquoteM ErrorPart
unquote Term
t = do
    Term
t <- Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
reduceQuotedTerm Term
t
    case Term
t of
      Con ConHead
c ConInfo
_ Elims
es | Just [Arg Term
x] <- Elims -> Maybe [Arg Term]
forall a. [Elim' a] -> Maybe [Arg a]
allApplyElims Elims
es ->
        [(UnquoteM Bool, UnquoteM ErrorPart)]
-> UnquoteM ErrorPart -> UnquoteM ErrorPart
forall (m :: * -> *) a. Monad m => [(m Bool, m a)] -> m a -> m a
choice [ (ConHead
c ConHead -> TCMT IO Term -> UnquoteM Bool
`isCon` TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primAgdaErrorPartString, [Char] -> ErrorPart
StrPart ([Char] -> ErrorPart)
-> (ExeName -> [Char]) -> ExeName -> ErrorPart
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExeName -> [Char]
T.unpack (ExeName -> ErrorPart) -> UnquoteM ExeName -> UnquoteM ErrorPart
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Arg Term -> UnquoteM ExeName
unquoteNString Arg Term
x)
               , (ConHead
c ConHead -> TCMT IO Term -> UnquoteM Bool
`isCon` TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primAgdaErrorPartTerm,   Expr -> ErrorPart
TermPart (Expr -> ErrorPart)
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Expr
-> UnquoteM ErrorPart
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((TCM Expr
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Expr
forall a.
TCM a
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     a
forall (tcm :: * -> *) a. MonadTCM tcm => TCM a -> tcm a
liftTCM (TCM Expr
 -> ReaderT
      Context
      (StateT
         UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
      Expr)
-> (Type -> TCM Expr)
-> Type
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type -> TCM Expr
Type -> TCMT IO (AbsOfRef Type)
forall r (m :: * -> *).
(ToAbstract r, MonadFresh NameId m, MonadError TCErr m,
 MonadTCEnv m, ReadTCState m, HasOptions m, HasBuiltins m,
 HasConstInfo m) =>
r -> m (AbsOfRef r)
toAbstractWithoutImplicit) (Type
 -> ReaderT
      Context
      (StateT
         UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
      Expr)
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Type
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Expr
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Arg Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Type
forall a. Unquote a => Arg Term -> UnquoteM a
unquoteN Arg Term
x :: UnquoteM R.Term)))
               , (ConHead
c ConHead -> TCMT IO Term -> UnquoteM Bool
`isCon` TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primAgdaErrorPartPatt,   Pattern -> ErrorPart
PattPart (Pattern -> ErrorPart)
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Pattern
-> UnquoteM ErrorPart
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((TCM Pattern
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Pattern
forall a.
TCM a
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     a
forall (tcm :: * -> *) a. MonadTCM tcm => TCM a -> tcm a
liftTCM (TCM Pattern
 -> ReaderT
      Context
      (StateT
         UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
      Pattern)
-> (Pattern -> TCM Pattern)
-> Pattern
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Pattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pattern -> TCM Pattern
Pattern -> TCMT IO (AbsOfRef Pattern)
forall r (m :: * -> *).
(ToAbstract r, MonadFresh NameId m, MonadError TCErr m,
 MonadTCEnv m, ReadTCState m, HasOptions m, HasBuiltins m,
 HasConstInfo m) =>
r -> m (AbsOfRef r)
toAbstractWithoutImplicit) (Pattern
 -> ReaderT
      Context
      (StateT
         UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
      Pattern)
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Pattern
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Pattern
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Arg Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Pattern
forall a. Unquote a => Arg Term -> UnquoteM a
unquoteN Arg Term
x :: UnquoteM R.Pattern)))
               , (ConHead
c ConHead -> TCMT IO Term -> UnquoteM Bool
`isCon` TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primAgdaErrorPartName,   QName -> ErrorPart
NamePart (QName -> ErrorPart) -> UnquoteM QName -> UnquoteM ErrorPart
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Arg Term -> UnquoteM QName
forall a. Unquote a => Arg Term -> UnquoteM a
unquoteN Arg Term
x) ]
               UnquoteM ErrorPart
forall a. HasCallStack => a
__IMPOSSIBLE__
      Term
_ -> UnquoteError -> UnquoteM ErrorPart
forall a.
UnquoteError
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (UnquoteError -> UnquoteM ErrorPart)
-> UnquoteError -> UnquoteM ErrorPart
forall a b. (a -> b) -> a -> b
$ [Char] -> Term -> UnquoteError
NonCanonical [Char]
"error part" Term
t

instance Unquote a => Unquote [a] where
  unquote :: Term -> UnquoteM [a]
unquote Term
t = do
    Term
t <- Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
reduceQuotedTerm Term
t
    case Term
t of
      Con ConHead
c ConInfo
_ Elims
es | Just [Arg Term
x,Arg Term
xs] <- Elims -> Maybe [Arg Term]
forall a. [Elim' a] -> Maybe [Arg a]
allApplyElims Elims
es ->
        [(UnquoteM Bool, UnquoteM [a])] -> UnquoteM [a] -> UnquoteM [a]
forall (m :: * -> *) a. Monad m => [(m Bool, m a)] -> m a -> m a
choice
          [(ConHead
c ConHead -> TCMT IO Term -> UnquoteM Bool
`isCon` TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primCons, (:) (a -> [a] -> [a])
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     a
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     ([a] -> [a])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Arg Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     a
forall a. Unquote a => Arg Term -> UnquoteM a
unquoteN Arg Term
x ReaderT
  Context
  (StateT
     UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
  ([a] -> [a])
-> UnquoteM [a] -> UnquoteM [a]
forall a b.
ReaderT
  Context
  (StateT
     UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
  (a -> b)
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     a
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Arg Term -> UnquoteM [a]
forall a. Unquote a => Arg Term -> UnquoteM a
unquoteN Arg Term
xs)]
          UnquoteM [a]
forall a. HasCallStack => a
__IMPOSSIBLE__
      Con ConHead
c ConInfo
_ [] ->
        [(UnquoteM Bool, UnquoteM [a])] -> UnquoteM [a] -> UnquoteM [a]
forall (m :: * -> *) a. Monad m => [(m Bool, m a)] -> m a -> m a
choice
          [(ConHead
c ConHead -> TCMT IO Term -> UnquoteM Bool
`isCon` TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primNil, [a] -> UnquoteM [a]
forall a.
a
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     a
forall (m :: * -> *) a. Monad m => a -> m a
return [])]
          UnquoteM [a]
forall a. HasCallStack => a
__IMPOSSIBLE__
      Con ConHead
c ConInfo
_ Elims
_ -> UnquoteM [a]
forall a. HasCallStack => a
__IMPOSSIBLE__
      Term
_ -> UnquoteError -> UnquoteM [a]
forall a.
UnquoteError
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (UnquoteError -> UnquoteM [a]) -> UnquoteError -> UnquoteM [a]
forall a b. (a -> b) -> a -> b
$ [Char] -> Term -> UnquoteError
NonCanonical [Char]
"list" Term
t

instance (Unquote a, Unquote b) => Unquote (a, b) where
  unquote :: Term -> UnquoteM (a, b)
unquote Term
t = do
    Term
t <- Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
reduceQuotedTerm Term
t
    SigmaKit{QName
ConHead
sigmaName :: QName
sigmaCon :: ConHead
sigmaFst :: QName
sigmaSnd :: QName
sigmaName :: SigmaKit -> QName
sigmaCon :: SigmaKit -> ConHead
sigmaFst :: SigmaKit -> QName
sigmaSnd :: SigmaKit -> QName
..} <- SigmaKit -> Maybe SigmaKit -> SigmaKit
forall a. a -> Maybe a -> a
fromMaybe SigmaKit
forall a. HasCallStack => a
__IMPOSSIBLE__ (Maybe SigmaKit -> SigmaKit)
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     (Maybe SigmaKit)
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     SigmaKit
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT
  Context
  (StateT
     UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
  (Maybe SigmaKit)
forall (m :: * -> *).
(HasBuiltins m, HasConstInfo m) =>
m (Maybe SigmaKit)
getSigmaKit
    case Term
t of
      Con ConHead
c ConInfo
_ Elims
es | Just [Arg Term
x,Arg Term
y] <- Elims -> Maybe [Arg Term]
forall a. [Elim' a] -> Maybe [Arg a]
allApplyElims Elims
es ->
        [(UnquoteM Bool, UnquoteM (a, b))]
-> UnquoteM (a, b) -> UnquoteM (a, b)
forall (m :: * -> *) a. Monad m => [(m Bool, m a)] -> m a -> m a
choice
          [(Bool -> UnquoteM Bool
forall a.
a
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ConHead
c ConHead -> ConHead -> Bool
forall a. Eq a => a -> a -> Bool
== ConHead
sigmaCon), (,) (a -> b -> (a, b))
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     a
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     (b -> (a, b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Arg Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     a
forall a. Unquote a => Arg Term -> UnquoteM a
unquoteN Arg Term
x ReaderT
  Context
  (StateT
     UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
  (b -> (a, b))
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     b
-> UnquoteM (a, b)
forall a b.
ReaderT
  Context
  (StateT
     UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
  (a -> b)
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     a
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Arg Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     b
forall a. Unquote a => Arg Term -> UnquoteM a
unquoteN Arg Term
y)]
          UnquoteM (a, b)
forall a. HasCallStack => a
__IMPOSSIBLE__
      Term
_ -> UnquoteError -> UnquoteM (a, b)
forall a.
UnquoteError
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (UnquoteError -> UnquoteM (a, b))
-> UnquoteError -> UnquoteM (a, b)
forall a b. (a -> b) -> a -> b
$ [Char] -> Term -> UnquoteError
NonCanonical [Char]
"pair" Term
t

instance Unquote Hiding where
  unquote :: Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Hiding
unquote Term
t = do
    Term
t <- Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
reduceQuotedTerm Term
t
    case Term
t of
      Con ConHead
c ConInfo
_ [] ->
        [(UnquoteM Bool,
  ReaderT
    Context
    (StateT
       UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
    Hiding)]
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Hiding
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Hiding
forall (m :: * -> *) a. Monad m => [(m Bool, m a)] -> m a -> m a
choice
          [(ConHead
c ConHead -> TCMT IO Term -> UnquoteM Bool
`isCon` TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primHidden,  Hiding
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Hiding
forall a.
a
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     a
forall (m :: * -> *) a. Monad m => a -> m a
return Hiding
Hidden)
          ,(ConHead
c ConHead -> TCMT IO Term -> UnquoteM Bool
`isCon` TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primInstance, Hiding
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Hiding
forall a.
a
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     a
forall (m :: * -> *) a. Monad m => a -> m a
return (Overlappable -> Hiding
Instance Overlappable
NoOverlap))
          ,(ConHead
c ConHead -> TCMT IO Term -> UnquoteM Bool
`isCon` TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primVisible, Hiding
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Hiding
forall a.
a
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     a
forall (m :: * -> *) a. Monad m => a -> m a
return Hiding
NotHidden)]
          ReaderT
  Context
  (StateT
     UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
  Hiding
forall a. HasCallStack => a
__IMPOSSIBLE__
      Con ConHead
c ConInfo
_ Elims
vs -> ReaderT
  Context
  (StateT
     UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
  Hiding
forall a. HasCallStack => a
__IMPOSSIBLE__
      Term
_        -> UnquoteError
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Hiding
forall a.
UnquoteError
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (UnquoteError
 -> ReaderT
      Context
      (StateT
         UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
      Hiding)
-> UnquoteError
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Hiding
forall a b. (a -> b) -> a -> b
$ [Char] -> Term -> UnquoteError
NonCanonical [Char]
"visibility" Term
t

instance Unquote Relevance where
  unquote :: Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Relevance
unquote Term
t = do
    Term
t <- Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
reduceQuotedTerm Term
t
    case Term
t of
      Con ConHead
c ConInfo
_ [] ->
        [(UnquoteM Bool,
  ReaderT
    Context
    (StateT
       UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
    Relevance)]
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Relevance
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Relevance
forall (m :: * -> *) a. Monad m => [(m Bool, m a)] -> m a -> m a
choice
          [(ConHead
c ConHead -> TCMT IO Term -> UnquoteM Bool
`isCon` TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primRelevant,   Relevance
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Relevance
forall a.
a
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     a
forall (m :: * -> *) a. Monad m => a -> m a
return Relevance
Relevant)
          ,(ConHead
c ConHead -> TCMT IO Term -> UnquoteM Bool
`isCon` TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primIrrelevant, Relevance
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Relevance
forall a.
a
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     a
forall (m :: * -> *) a. Monad m => a -> m a
return Relevance
Irrelevant)]
          ReaderT
  Context
  (StateT
     UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
  Relevance
forall a. HasCallStack => a
__IMPOSSIBLE__
      Con ConHead
c ConInfo
_ Elims
vs -> ReaderT
  Context
  (StateT
     UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
  Relevance
forall a. HasCallStack => a
__IMPOSSIBLE__
      Term
_        -> UnquoteError
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Relevance
forall a.
UnquoteError
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (UnquoteError
 -> ReaderT
      Context
      (StateT
         UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
      Relevance)
-> UnquoteError
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Relevance
forall a b. (a -> b) -> a -> b
$ [Char] -> Term -> UnquoteError
NonCanonical [Char]
"relevance" Term
t

instance Unquote Quantity where
  unquote :: Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Quantity
unquote Term
t = do
    Term
t <- Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
reduceQuotedTerm Term
t
    case Term
t of
      Con ConHead
c ConInfo
_ [] ->
        [(UnquoteM Bool,
  ReaderT
    Context
    (StateT
       UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
    Quantity)]
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Quantity
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Quantity
forall (m :: * -> *) a. Monad m => [(m Bool, m a)] -> m a -> m a
choice
          [(ConHead
c ConHead -> TCMT IO Term -> UnquoteM Bool
`isCon` TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primQuantityω, Quantity
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Quantity
forall a.
a
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     a
forall (m :: * -> *) a. Monad m => a -> m a
return (Quantity
 -> ReaderT
      Context
      (StateT
         UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
      Quantity)
-> Quantity
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Quantity
forall a b. (a -> b) -> a -> b
$ QωOrigin -> Quantity
Quantityω QωOrigin
QωInferred)
          ,(ConHead
c ConHead -> TCMT IO Term -> UnquoteM Bool
`isCon` TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primQuantity0, Quantity
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Quantity
forall a.
a
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     a
forall (m :: * -> *) a. Monad m => a -> m a
return (Quantity
 -> ReaderT
      Context
      (StateT
         UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
      Quantity)
-> Quantity
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Quantity
forall a b. (a -> b) -> a -> b
$ Q0Origin -> Quantity
Quantity0 Q0Origin
Q0Inferred)]
          ReaderT
  Context
  (StateT
     UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
  Quantity
forall a. HasCallStack => a
__IMPOSSIBLE__
      Con ConHead
c ConInfo
_ Elims
vs -> ReaderT
  Context
  (StateT
     UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
  Quantity
forall a. HasCallStack => a
__IMPOSSIBLE__
      Term
_        -> UnquoteError
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Quantity
forall a.
UnquoteError
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (UnquoteError
 -> ReaderT
      Context
      (StateT
         UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
      Quantity)
-> UnquoteError
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Quantity
forall a b. (a -> b) -> a -> b
$ [Char] -> Term -> UnquoteError
NonCanonical [Char]
"quantity" Term
t

instance Unquote QName where
  unquote :: Term -> UnquoteM QName
unquote Term
t = do
    Term
t <- Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
reduceQuotedTerm Term
t
    case Term
t of
      Lit (LitQName QName
x) -> QName -> UnquoteM QName
forall a.
a
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     a
forall (m :: * -> *) a. Monad m => a -> m a
return QName
x
      Term
_ -> UnquoteError -> UnquoteM QName
forall a.
UnquoteError
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (UnquoteError -> UnquoteM QName) -> UnquoteError -> UnquoteM QName
forall a b. (a -> b) -> a -> b
$ [Char] -> Term -> UnquoteError
NonCanonical [Char]
"name" Term
t

instance Unquote a => Unquote (R.Abs a) where
  unquote :: Term -> UnquoteM (Abs a)
unquote Term
t = do
    Term
t <- Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
reduceQuotedTerm Term
t
    case Term
t of
      Con ConHead
c ConInfo
_ Elims
es | Just [Arg Term
x,Arg Term
y] <- Elims -> Maybe [Arg Term]
forall a. [Elim' a] -> Maybe [Arg a]
allApplyElims Elims
es ->
        [(UnquoteM Bool, UnquoteM (Abs a))]
-> UnquoteM (Abs a) -> UnquoteM (Abs a)
forall (m :: * -> *) a. Monad m => [(m Bool, m a)] -> m a -> m a
choice
          [(ConHead
c ConHead -> TCMT IO Term -> UnquoteM Bool
`isCon` TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primAbsAbs, [Char] -> a -> Abs a
forall a. [Char] -> a -> Abs a
R.Abs ([Char] -> a -> Abs a)
-> UnquoteM [Char]
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     (a -> Abs a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Char] -> [Char]
forall {t :: * -> *} {a}.
(Foldable t, IsString (t a)) =>
t a -> t a
hint ([Char] -> [Char]) -> (ExeName -> [Char]) -> ExeName -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExeName -> [Char]
T.unpack (ExeName -> [Char]) -> UnquoteM ExeName -> UnquoteM [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Arg Term -> UnquoteM ExeName
unquoteNString Arg Term
x) ReaderT
  Context
  (StateT
     UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
  (a -> Abs a)
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     a
-> UnquoteM (Abs a)
forall a b.
ReaderT
  Context
  (StateT
     UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
  (a -> b)
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     a
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Arg Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     a
forall a. Unquote a => Arg Term -> UnquoteM a
unquoteN Arg Term
y)]
          UnquoteM (Abs a)
forall a. HasCallStack => a
__IMPOSSIBLE__
      Con ConHead
c ConInfo
_ Elims
_ -> UnquoteM (Abs a)
forall a. HasCallStack => a
__IMPOSSIBLE__
      Term
_ -> UnquoteError -> UnquoteM (Abs a)
forall a.
UnquoteError
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (UnquoteError -> UnquoteM (Abs a))
-> UnquoteError -> UnquoteM (Abs a)
forall a b. (a -> b) -> a -> b
$ [Char] -> Term -> UnquoteError
NonCanonical [Char]
"abstraction" Term
t

    where hint :: t a -> t a
hint t a
x | Bool -> Bool
not (t a -> Bool
forall a. t a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null t a
x) = t a
x
                 | Bool
otherwise    = t a
"_"

instance Unquote MetaId where
  unquote :: Term -> UnquoteM MetaId
unquote Term
t = do
    Term
t <- Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
reduceQuotedTerm Term
t
    case Term
t of
      Lit (LitMeta TopLevelModuleName
m MetaId
x) -> TCM MetaId -> UnquoteM MetaId
forall a.
TCM a
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     a
forall (tcm :: * -> *) a. MonadTCM tcm => TCM a -> tcm a
liftTCM (TCM MetaId -> UnquoteM MetaId) -> TCM MetaId -> UnquoteM MetaId
forall a b. (a -> b) -> a -> b
$ do
        Bool
live <- (TopLevelModuleName -> Maybe TopLevelModuleName
forall a. a -> Maybe a
Just TopLevelModuleName
m Maybe TopLevelModuleName -> Maybe TopLevelModuleName -> Bool
forall a. Eq a => a -> a -> Bool
==) (Maybe TopLevelModuleName -> Bool)
-> TCMT IO (Maybe TopLevelModuleName) -> TCMT IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TCMT IO (Maybe TopLevelModuleName)
forall (m :: * -> *).
(MonadTCEnv m, ReadTCState m) =>
m (Maybe TopLevelModuleName)
currentTopLevelModule
        Bool -> TCMT IO () -> TCMT IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
live (TCMT IO () -> TCMT IO ()) -> TCMT IO () -> TCMT IO ()
forall a b. (a -> b) -> a -> b
$
            TypeError -> TCMT IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadTCError m) =>
TypeError -> m a
typeError (TypeError -> TCMT IO ())
-> (Doc -> TypeError) -> Doc -> TCMT IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> TypeError
GenericDocError (Doc -> TCMT IO ()) -> TCMT IO Doc -> TCMT IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
              [TCMT IO Doc] -> TCMT IO Doc
forall (m :: * -> *) (t :: * -> *).
(Applicative m, Foldable t) =>
t (m Doc) -> m Doc
sep [ TCMT IO Doc
"Can't unquote stale metavariable"
                  , TopLevelModuleName -> TCMT IO Doc
forall (m :: * -> *) a. (Applicative m, Pretty a) => a -> m Doc
pretty TopLevelModuleName
m TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
forall a. Semigroup a => a -> a -> a
<> TCMT IO Doc
"._" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
forall a. Semigroup a => a -> a -> a
<> Word64 -> TCMT IO Doc
forall (m :: * -> *) a. (Applicative m, Pretty a) => a -> m Doc
pretty (MetaId -> Word64
metaId MetaId
x) ]
        MetaId -> TCM MetaId
forall a. a -> TCMT IO a
forall (m :: * -> *) a. Monad m => a -> m a
return MetaId
x
      Term
_ -> UnquoteError -> UnquoteM MetaId
forall a.
UnquoteError
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (UnquoteError -> UnquoteM MetaId)
-> UnquoteError -> UnquoteM MetaId
forall a b. (a -> b) -> a -> b
$ [Char] -> Term -> UnquoteError
NonCanonical [Char]
"meta variable" Term
t

instance Unquote a => Unquote (Dom a) where
  unquote :: Term -> UnquoteM (Dom a)
unquote Term
t = Arg a -> Dom a
forall a. Arg a -> Dom a
domFromArg (Arg a -> Dom a)
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     (Arg a)
-> UnquoteM (Dom a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     (Arg a)
forall a. Unquote a => Term -> UnquoteM a
unquote Term
t

instance Unquote R.Sort where
  unquote :: Term -> UnquoteM Sort
unquote Term
t = do
    Term
t <- Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
reduceQuotedTerm Term
t
    case Term
t of
      Con ConHead
c ConInfo
_ [] ->
        [(UnquoteM Bool, UnquoteM Sort)] -> UnquoteM Sort -> UnquoteM Sort
forall (m :: * -> *) a. Monad m => [(m Bool, m a)] -> m a -> m a
choice
          [(ConHead
c ConHead -> TCMT IO Term -> UnquoteM Bool
`isCon` TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primAgdaSortUnsupported, Sort -> UnquoteM Sort
forall a.
a
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     a
forall (m :: * -> *) a. Monad m => a -> m a
return Sort
R.UnknownS)]
          UnquoteM Sort
forall a. HasCallStack => a
__IMPOSSIBLE__
      Con ConHead
c ConInfo
_ Elims
es | Just [Arg Term
u] <- Elims -> Maybe [Arg Term]
forall a. [Elim' a] -> Maybe [Arg a]
allApplyElims Elims
es ->
        [(UnquoteM Bool, UnquoteM Sort)] -> UnquoteM Sort -> UnquoteM Sort
forall (m :: * -> *) a. Monad m => [(m Bool, m a)] -> m a -> m a
choice
          [ (ConHead
c ConHead -> TCMT IO Term -> UnquoteM Bool
`isCon` TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primAgdaSortSet, Type -> Sort
R.SetS (Type -> Sort)
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Type
-> UnquoteM Sort
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Arg Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Type
forall a. Unquote a => Arg Term -> UnquoteM a
unquoteN Arg Term
u)
          , (ConHead
c ConHead -> TCMT IO Term -> UnquoteM Bool
`isCon` TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primAgdaSortLit, Integer -> Sort
R.LitS (Integer -> Sort) -> UnquoteM Integer -> UnquoteM Sort
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Arg Term -> UnquoteM Integer
forall a. Unquote a => Arg Term -> UnquoteM a
unquoteN Arg Term
u)
          , (ConHead
c ConHead -> TCMT IO Term -> UnquoteM Bool
`isCon` TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primAgdaSortProp, Type -> Sort
R.PropS (Type -> Sort)
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Type
-> UnquoteM Sort
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Arg Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Type
forall a. Unquote a => Arg Term -> UnquoteM a
unquoteN Arg Term
u)
          , (ConHead
c ConHead -> TCMT IO Term -> UnquoteM Bool
`isCon` TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primAgdaSortPropLit, Integer -> Sort
R.PropLitS (Integer -> Sort) -> UnquoteM Integer -> UnquoteM Sort
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Arg Term -> UnquoteM Integer
forall a. Unquote a => Arg Term -> UnquoteM a
unquoteN Arg Term
u)
          , (ConHead
c ConHead -> TCMT IO Term -> UnquoteM Bool
`isCon` TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primAgdaSortInf, Integer -> Sort
R.InfS (Integer -> Sort) -> UnquoteM Integer -> UnquoteM Sort
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Arg Term -> UnquoteM Integer
forall a. Unquote a => Arg Term -> UnquoteM a
unquoteN Arg Term
u)
          ]
          UnquoteM Sort
forall a. HasCallStack => a
__IMPOSSIBLE__
      Con ConHead
c ConInfo
_ Elims
_ -> UnquoteM Sort
forall a. HasCallStack => a
__IMPOSSIBLE__
      Term
_ -> UnquoteError -> UnquoteM Sort
forall a.
UnquoteError
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (UnquoteError -> UnquoteM Sort) -> UnquoteError -> UnquoteM Sort
forall a b. (a -> b) -> a -> b
$ [Char] -> Term -> UnquoteError
NonCanonical [Char]
"sort" Term
t

instance Unquote Literal where
  unquote :: Term -> UnquoteM Literal
unquote Term
t = do
    Term
t <- Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
reduceQuotedTerm Term
t
    case Term
t of
      Con ConHead
c ConInfo
_ Elims
es | Just [Arg Term
x] <- Elims -> Maybe [Arg Term]
forall a. [Elim' a] -> Maybe [Arg a]
allApplyElims Elims
es ->
        [(UnquoteM Bool, UnquoteM Literal)]
-> UnquoteM Literal -> UnquoteM Literal
forall (m :: * -> *) a. Monad m => [(m Bool, m a)] -> m a -> m a
choice
          [ (ConHead
c ConHead -> TCMT IO Term -> UnquoteM Bool
`isCon` TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primAgdaLitNat,    Integer -> Literal
LitNat    (Integer -> Literal) -> UnquoteM Integer -> UnquoteM Literal
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Arg Term -> UnquoteM Integer
forall a. Unquote a => Arg Term -> UnquoteM a
unquoteN Arg Term
x)
          , (ConHead
c ConHead -> TCMT IO Term -> UnquoteM Bool
`isCon` TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primAgdaLitFloat,  Double -> Literal
LitFloat  (Double -> Literal) -> UnquoteM Double -> UnquoteM Literal
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Arg Term -> UnquoteM Double
forall a. Unquote a => Arg Term -> UnquoteM a
unquoteN Arg Term
x)
          , (ConHead
c ConHead -> TCMT IO Term -> UnquoteM Bool
`isCon` TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primAgdaLitChar,   Char -> Literal
LitChar   (Char -> Literal) -> UnquoteM Char -> UnquoteM Literal
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Arg Term -> UnquoteM Char
forall a. Unquote a => Arg Term -> UnquoteM a
unquoteN Arg Term
x)
          , (ConHead
c ConHead -> TCMT IO Term -> UnquoteM Bool
`isCon` TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primAgdaLitString, ExeName -> Literal
LitString (ExeName -> Literal) -> UnquoteM ExeName -> UnquoteM Literal
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Arg Term -> UnquoteM ExeName
unquoteNString Arg Term
x)
          , (ConHead
c ConHead -> TCMT IO Term -> UnquoteM Bool
`isCon` TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primAgdaLitQName,  QName -> Literal
LitQName  (QName -> Literal) -> UnquoteM QName -> UnquoteM Literal
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Arg Term -> UnquoteM QName
forall a. Unquote a => Arg Term -> UnquoteM a
unquoteN Arg Term
x)
          , (ConHead
c ConHead -> TCMT IO Term -> UnquoteM Bool
`isCon` TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primAgdaLitMeta,
             TopLevelModuleName -> MetaId -> Literal
LitMeta
               (TopLevelModuleName -> MetaId -> Literal)
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     TopLevelModuleName
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     (MetaId -> Literal)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (TopLevelModuleName
-> Maybe TopLevelModuleName -> TopLevelModuleName
forall a. a -> Maybe a -> a
fromMaybe TopLevelModuleName
forall a. HasCallStack => a
__IMPOSSIBLE__ (Maybe TopLevelModuleName -> TopLevelModuleName)
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     (Maybe TopLevelModuleName)
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     TopLevelModuleName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT
  Context
  (StateT
     UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
  (Maybe TopLevelModuleName)
forall (m :: * -> *).
(MonadTCEnv m, ReadTCState m) =>
m (Maybe TopLevelModuleName)
currentTopLevelModule)
               ReaderT
  Context
  (StateT
     UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
  (MetaId -> Literal)
-> UnquoteM MetaId -> UnquoteM Literal
forall a b.
ReaderT
  Context
  (StateT
     UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
  (a -> b)
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     a
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Arg Term -> UnquoteM MetaId
forall a. Unquote a => Arg Term -> UnquoteM a
unquoteN Arg Term
x)
          ]
          UnquoteM Literal
forall a. HasCallStack => a
__IMPOSSIBLE__
      Con ConHead
c ConInfo
_ Elims
_ -> UnquoteM Literal
forall a. HasCallStack => a
__IMPOSSIBLE__
      Term
_ -> UnquoteError -> UnquoteM Literal
forall a.
UnquoteError
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (UnquoteError -> UnquoteM Literal)
-> UnquoteError -> UnquoteM Literal
forall a b. (a -> b) -> a -> b
$ [Char] -> Term -> UnquoteError
NonCanonical [Char]
"literal" Term
t

instance Unquote R.Term where
  unquote :: Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Type
unquote Term
t = do
    Term
t <- Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
reduceQuotedTerm Term
t
    case Term
t of
      Con ConHead
c ConInfo
_ [] ->
        [(UnquoteM Bool,
  ReaderT
    Context
    (StateT
       UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
    Type)]
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Type
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Type
forall (m :: * -> *) a. Monad m => [(m Bool, m a)] -> m a -> m a
choice
          [ (ConHead
c ConHead -> TCMT IO Term -> UnquoteM Bool
`isCon` TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primAgdaTermUnsupported, Type
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Type
forall a.
a
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     a
forall (m :: * -> *) a. Monad m => a -> m a
return Type
R.Unknown) ]
          ReaderT
  Context
  (StateT
     UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
  Type
forall a. HasCallStack => a
__IMPOSSIBLE__

      Con ConHead
c ConInfo
_ Elims
es | Just [Arg Term
x] <- Elims -> Maybe [Arg Term]
forall a. [Elim' a] -> Maybe [Arg a]
allApplyElims Elims
es ->
        [(UnquoteM Bool,
  ReaderT
    Context
    (StateT
       UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
    Type)]
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Type
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Type
forall (m :: * -> *) a. Monad m => [(m Bool, m a)] -> m a -> m a
choice
          [ (ConHead
c ConHead -> TCMT IO Term -> UnquoteM Bool
`isCon` TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primAgdaTermSort,      Sort -> Type
R.Sort      (Sort -> Type)
-> UnquoteM Sort
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Type
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Arg Term -> UnquoteM Sort
forall a. Unquote a => Arg Term -> UnquoteM a
unquoteN Arg Term
x)
          , (ConHead
c ConHead -> TCMT IO Term -> UnquoteM Bool
`isCon` TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primAgdaTermLit,       Literal -> Type
R.Lit       (Literal -> Type)
-> UnquoteM Literal
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Type
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Arg Term -> UnquoteM Literal
forall a. Unquote a => Arg Term -> UnquoteM a
unquoteN Arg Term
x)
          ]
          ReaderT
  Context
  (StateT
     UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
  Type
forall a. HasCallStack => a
__IMPOSSIBLE__

      Con ConHead
c ConInfo
_ Elims
es | Just [Arg Term
x, Arg Term
y] <- Elims -> Maybe [Arg Term]
forall a. [Elim' a] -> Maybe [Arg a]
allApplyElims Elims
es ->
        [(UnquoteM Bool,
  ReaderT
    Context
    (StateT
       UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
    Type)]
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Type
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Type
forall (m :: * -> *) a. Monad m => [(m Bool, m a)] -> m a -> m a
choice
          [ (ConHead
c ConHead -> TCMT IO Term -> UnquoteM Bool
`isCon` TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primAgdaTermVar,     Int -> Elims -> Type
R.Var     (Int -> Elims -> Type)
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Int
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     (Elims -> Type)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Integer -> Int)
-> UnquoteM Integer
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Arg Term -> UnquoteM Integer
forall a. Unquote a => Arg Term -> UnquoteM a
unquoteN Arg Term
x) ReaderT
  Context
  (StateT
     UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
  (Elims -> Type)
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Elims
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Type
forall a b.
ReaderT
  Context
  (StateT
     UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
  (a -> b)
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     a
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Arg Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Elims
forall a. Unquote a => Arg Term -> UnquoteM a
unquoteN Arg Term
y)
          , (ConHead
c ConHead -> TCMT IO Term -> UnquoteM Bool
`isCon` TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primAgdaTermCon,     QName -> Elims -> Type
R.Con     (QName -> Elims -> Type)
-> UnquoteM QName
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     (Elims -> Type)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> UnquoteM QName
ensureCon (QName -> UnquoteM QName) -> UnquoteM QName -> UnquoteM QName
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Arg Term -> UnquoteM QName
forall a. Unquote a => Arg Term -> UnquoteM a
unquoteN Arg Term
x) ReaderT
  Context
  (StateT
     UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
  (Elims -> Type)
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Elims
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Type
forall a b.
ReaderT
  Context
  (StateT
     UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
  (a -> b)
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     a
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Arg Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Elims
forall a. Unquote a => Arg Term -> UnquoteM a
unquoteN Arg Term
y)
          , (ConHead
c ConHead -> TCMT IO Term -> UnquoteM Bool
`isCon` TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primAgdaTermDef,     QName -> Elims -> Type
R.Def     (QName -> Elims -> Type)
-> UnquoteM QName
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     (Elims -> Type)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> UnquoteM QName
ensureDef (QName -> UnquoteM QName) -> UnquoteM QName -> UnquoteM QName
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Arg Term -> UnquoteM QName
forall a. Unquote a => Arg Term -> UnquoteM a
unquoteN Arg Term
x) ReaderT
  Context
  (StateT
     UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
  (Elims -> Type)
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Elims
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Type
forall a b.
ReaderT
  Context
  (StateT
     UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
  (a -> b)
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     a
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Arg Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Elims
forall a. Unquote a => Arg Term -> UnquoteM a
unquoteN Arg Term
y)
          , (ConHead
c ConHead -> TCMT IO Term -> UnquoteM Bool
`isCon` TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primAgdaTermMeta,    MetaId -> Elims -> Type
R.Meta    (MetaId -> Elims -> Type)
-> UnquoteM MetaId
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     (Elims -> Type)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Arg Term -> UnquoteM MetaId
forall a. Unquote a => Arg Term -> UnquoteM a
unquoteN Arg Term
x ReaderT
  Context
  (StateT
     UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
  (Elims -> Type)
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Elims
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Type
forall a b.
ReaderT
  Context
  (StateT
     UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
  (a -> b)
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     a
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Arg Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Elims
forall a. Unquote a => Arg Term -> UnquoteM a
unquoteN Arg Term
y)
          , (ConHead
c ConHead -> TCMT IO Term -> UnquoteM Bool
`isCon` TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primAgdaTermLam,     Hiding -> Abs Type -> Type
R.Lam     (Hiding -> Abs Type -> Type)
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Hiding
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     (Abs Type -> Type)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Arg Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Hiding
forall a. Unquote a => Arg Term -> UnquoteM a
unquoteN Arg Term
x ReaderT
  Context
  (StateT
     UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
  (Abs Type -> Type)
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     (Abs Type)
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Type
forall a b.
ReaderT
  Context
  (StateT
     UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
  (a -> b)
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     a
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Arg Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     (Abs Type)
forall a. Unquote a => Arg Term -> UnquoteM a
unquoteN Arg Term
y)
          , (ConHead
c ConHead -> TCMT IO Term -> UnquoteM Bool
`isCon` TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primAgdaTermPi,      Dom Type -> Abs Type -> Type
mkPi      (Dom Type -> Abs Type -> Type)
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     (Dom Type)
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     (Abs Type -> Type)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Arg Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     (Dom Type)
forall a. Unquote a => Arg Term -> UnquoteM a
unquoteN Arg Term
x ReaderT
  Context
  (StateT
     UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
  (Abs Type -> Type)
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     (Abs Type)
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Type
forall a b.
ReaderT
  Context
  (StateT
     UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
  (a -> b)
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     a
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Arg Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     (Abs Type)
forall a. Unquote a => Arg Term -> UnquoteM a
unquoteN Arg Term
y)
          , (ConHead
c ConHead -> TCMT IO Term -> UnquoteM Bool
`isCon` TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primAgdaTermExtLam,  List1 Clause -> Elims -> Type
R.ExtLam  (List1 Clause -> Elims -> Type)
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     (List1 Clause)
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     (Elims -> Type)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (List1 Clause -> [Clause] -> List1 Clause
forall a. List1 a -> [a] -> List1 a
List1.fromListSafe List1 Clause
forall a. HasCallStack => a
__IMPOSSIBLE__ ([Clause] -> List1 Clause)
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     [Clause]
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     (List1 Clause)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Arg Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     [Clause]
forall a. Unquote a => Arg Term -> UnquoteM a
unquoteN Arg Term
x) ReaderT
  Context
  (StateT
     UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
  (Elims -> Type)
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Elims
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Type
forall a b.
ReaderT
  Context
  (StateT
     UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
  (a -> b)
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     a
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Arg Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Elims
forall a. Unquote a => Arg Term -> UnquoteM a
unquoteN Arg Term
y)
          ]
          ReaderT
  Context
  (StateT
     UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
  Type
forall a. HasCallStack => a
__IMPOSSIBLE__
        where
          mkPi :: Dom R.Type -> R.Abs R.Type -> R.Term
          -- TODO: implement Free for reflected syntax so this works again
          --mkPi a (R.Abs "_" b) = R.Pi a (R.Abs x b)
          --  where x | 0 `freeIn` b = pickName (unDom a)
          --          | otherwise    = "_"
          mkPi :: Dom Type -> Abs Type -> Type
mkPi Dom Type
a (R.Abs [Char]
"_" Type
b) = Dom Type -> Abs Type -> Type
R.Pi Dom Type
a ([Char] -> Type -> Abs Type
forall a. [Char] -> a -> Abs a
R.Abs (Type -> [Char]
pickName (Dom Type -> Type
forall t e. Dom' t e -> e
unDom Dom Type
a)) Type
b)
          mkPi Dom Type
a Abs Type
b = Dom Type -> Abs Type -> Type
R.Pi Dom Type
a Abs Type
b

      Con{} -> ReaderT
  Context
  (StateT
     UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
  Type
forall a. HasCallStack => a
__IMPOSSIBLE__
      Lit{} -> ReaderT
  Context
  (StateT
     UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
  Type
forall a. HasCallStack => a
__IMPOSSIBLE__
      Term
_ -> UnquoteError
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Type
forall a.
UnquoteError
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (UnquoteError
 -> ReaderT
      Context
      (StateT
         UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
      Type)
-> UnquoteError
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Type
forall a b. (a -> b) -> a -> b
$ [Char] -> Term -> UnquoteError
NonCanonical [Char]
"term" Term
t

instance Unquote R.Pattern where
  unquote :: Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Pattern
unquote Term
t = do
    Term
t <- Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
reduceQuotedTerm Term
t
    case Term
t of
      Con ConHead
c ConInfo
_ Elims
es | Just [Arg Term
x] <- Elims -> Maybe [Arg Term]
forall a. [Elim' a] -> Maybe [Arg a]
allApplyElims Elims
es ->
        [(UnquoteM Bool,
  ReaderT
    Context
    (StateT
       UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
    Pattern)]
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Pattern
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Pattern
forall (m :: * -> *) a. Monad m => [(m Bool, m a)] -> m a -> m a
choice
          [ (ConHead
c ConHead -> TCMT IO Term -> UnquoteM Bool
`isCon` TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primAgdaPatVar,    Int -> Pattern
R.VarP    (Int -> Pattern) -> (Integer -> Int) -> Integer -> Pattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Integer -> Pattern)
-> UnquoteM Integer
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Pattern
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Arg Term -> UnquoteM Integer
forall a. Unquote a => Arg Term -> UnquoteM a
unquoteN Arg Term
x)
          , (ConHead
c ConHead -> TCMT IO Term -> UnquoteM Bool
`isCon` TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primAgdaPatAbsurd, Int -> Pattern
R.AbsurdP (Int -> Pattern) -> (Integer -> Int) -> Integer -> Pattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Integer -> Pattern)
-> UnquoteM Integer
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Pattern
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Arg Term -> UnquoteM Integer
forall a. Unquote a => Arg Term -> UnquoteM a
unquoteN Arg Term
x)
          , (ConHead
c ConHead -> TCMT IO Term -> UnquoteM Bool
`isCon` TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primAgdaPatDot,    Type -> Pattern
R.DotP  (Type -> Pattern)
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Type
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Pattern
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Arg Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Type
forall a. Unquote a => Arg Term -> UnquoteM a
unquoteN Arg Term
x)
          , (ConHead
c ConHead -> TCMT IO Term -> UnquoteM Bool
`isCon` TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primAgdaPatProj,   QName -> Pattern
R.ProjP (QName -> Pattern)
-> UnquoteM QName
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Pattern
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Arg Term -> UnquoteM QName
forall a. Unquote a => Arg Term -> UnquoteM a
unquoteN Arg Term
x)
          , (ConHead
c ConHead -> TCMT IO Term -> UnquoteM Bool
`isCon` TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primAgdaPatLit,    Literal -> Pattern
R.LitP  (Literal -> Pattern)
-> UnquoteM Literal
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Pattern
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Arg Term -> UnquoteM Literal
forall a. Unquote a => Arg Term -> UnquoteM a
unquoteN Arg Term
x) ]
          ReaderT
  Context
  (StateT
     UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
  Pattern
forall a. HasCallStack => a
__IMPOSSIBLE__
      Con ConHead
c ConInfo
_ Elims
es | Just [Arg Term
x, Arg Term
y] <- Elims -> Maybe [Arg Term]
forall a. [Elim' a] -> Maybe [Arg a]
allApplyElims Elims
es ->
        [(UnquoteM Bool,
  ReaderT
    Context
    (StateT
       UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
    Pattern)]
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Pattern
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Pattern
forall (m :: * -> *) a. Monad m => [(m Bool, m a)] -> m a -> m a
choice
          [ (ConHead
c ConHead -> TCMT IO Term -> UnquoteM Bool
`isCon` TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primAgdaPatCon, QName -> [Arg Pattern] -> Pattern
R.ConP (QName -> [Arg Pattern] -> Pattern)
-> UnquoteM QName
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     ([Arg Pattern] -> Pattern)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Arg Term -> UnquoteM QName
forall a. Unquote a => Arg Term -> UnquoteM a
unquoteN Arg Term
x ReaderT
  Context
  (StateT
     UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
  ([Arg Pattern] -> Pattern)
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     [Arg Pattern]
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Pattern
forall a b.
ReaderT
  Context
  (StateT
     UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
  (a -> b)
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     a
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Arg Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     [Arg Pattern]
forall a. Unquote a => Arg Term -> UnquoteM a
unquoteN Arg Term
y) ]
          ReaderT
  Context
  (StateT
     UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
  Pattern
forall a. HasCallStack => a
__IMPOSSIBLE__
      Con ConHead
c ConInfo
_ Elims
_ -> ReaderT
  Context
  (StateT
     UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
  Pattern
forall a. HasCallStack => a
__IMPOSSIBLE__
      Term
_ -> UnquoteError
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Pattern
forall a.
UnquoteError
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (UnquoteError
 -> ReaderT
      Context
      (StateT
         UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
      Pattern)
-> UnquoteError
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Pattern
forall a b. (a -> b) -> a -> b
$ [Char] -> Term -> UnquoteError
NonCanonical [Char]
"pattern" Term
t

instance Unquote R.Clause where
  unquote :: Term -> UnquoteM Clause
unquote Term
t = do
    Term
t <- Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
reduceQuotedTerm Term
t
    case Term
t of
      Con ConHead
c ConInfo
_ Elims
es | Just [Arg Term
x, Arg Term
y] <- Elims -> Maybe [Arg Term]
forall a. [Elim' a] -> Maybe [Arg a]
allApplyElims Elims
es ->
        [(UnquoteM Bool, UnquoteM Clause)]
-> UnquoteM Clause -> UnquoteM Clause
forall (m :: * -> *) a. Monad m => [(m Bool, m a)] -> m a -> m a
choice
          [ (ConHead
c ConHead -> TCMT IO Term -> UnquoteM Bool
`isCon` TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primAgdaClauseAbsurd, [(ExeName, Arg Type)] -> [Arg Pattern] -> Clause
R.AbsurdClause ([(ExeName, Arg Type)] -> [Arg Pattern] -> Clause)
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     [(ExeName, Arg Type)]
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     ([Arg Pattern] -> Clause)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Arg Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     [(ExeName, Arg Type)]
forall a. Unquote a => Arg Term -> UnquoteM a
unquoteN Arg Term
x ReaderT
  Context
  (StateT
     UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
  ([Arg Pattern] -> Clause)
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     [Arg Pattern]
-> UnquoteM Clause
forall a b.
ReaderT
  Context
  (StateT
     UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
  (a -> b)
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     a
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Arg Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     [Arg Pattern]
forall a. Unquote a => Arg Term -> UnquoteM a
unquoteN Arg Term
y) ]
          UnquoteM Clause
forall a. HasCallStack => a
__IMPOSSIBLE__
      Con ConHead
c ConInfo
_ Elims
es | Just [Arg Term
x, Arg Term
y, Arg Term
z] <- Elims -> Maybe [Arg Term]
forall a. [Elim' a] -> Maybe [Arg a]
allApplyElims Elims
es ->
        [(UnquoteM Bool, UnquoteM Clause)]
-> UnquoteM Clause -> UnquoteM Clause
forall (m :: * -> *) a. Monad m => [(m Bool, m a)] -> m a -> m a
choice
          [ (ConHead
c ConHead -> TCMT IO Term -> UnquoteM Bool
`isCon` TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primAgdaClauseClause, [(ExeName, Arg Type)] -> [Arg Pattern] -> Type -> Clause
R.Clause ([(ExeName, Arg Type)] -> [Arg Pattern] -> Type -> Clause)
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     [(ExeName, Arg Type)]
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     ([Arg Pattern] -> Type -> Clause)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Arg Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     [(ExeName, Arg Type)]
forall a. Unquote a => Arg Term -> UnquoteM a
unquoteN Arg Term
x ReaderT
  Context
  (StateT
     UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
  ([Arg Pattern] -> Type -> Clause)
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     [Arg Pattern]
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     (Type -> Clause)
forall a b.
ReaderT
  Context
  (StateT
     UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
  (a -> b)
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     a
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Arg Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     [Arg Pattern]
forall a. Unquote a => Arg Term -> UnquoteM a
unquoteN Arg Term
y ReaderT
  Context
  (StateT
     UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
  (Type -> Clause)
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Type
-> UnquoteM Clause
forall a b.
ReaderT
  Context
  (StateT
     UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
  (a -> b)
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     a
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Arg Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Type
forall a. Unquote a => Arg Term -> UnquoteM a
unquoteN Arg Term
z) ]
          UnquoteM Clause
forall a. HasCallStack => a
__IMPOSSIBLE__
      Con ConHead
c ConInfo
_ Elims
_ -> UnquoteM Clause
forall a. HasCallStack => a
__IMPOSSIBLE__
      Term
_ -> UnquoteError -> UnquoteM Clause
forall a.
UnquoteError
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (UnquoteError -> UnquoteM Clause)
-> UnquoteError -> UnquoteM Clause
forall a b. (a -> b) -> a -> b
$ [Char] -> Term -> UnquoteError
NonCanonical [Char]
"clause" Term
t

-- Unquoting TCM computations ---------------------------------------------

-- | Argument should be a term of type @Term → TCM A@ for some A. Returns the
--   resulting term of type @A@. The second argument is the term for the hole,
--   which will typically be a metavariable. This is passed to the computation
--   (quoted).
unquoteTCM :: I.Term -> I.Term -> UnquoteM I.Term
unquoteTCM :: Term
-> Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
unquoteTCM Term
m Term
hole = do
  Term
qhole <- TCMT IO Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
forall a.
TCM a
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     a
forall (tcm :: * -> *) a. MonadTCM tcm => TCM a -> tcm a
liftTCM (TCMT IO Term
 -> ReaderT
      Context
      (StateT
         UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
      Term)
-> TCMT IO Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
forall a b. (a -> b) -> a -> b
$ Term -> TCMT IO Term
quoteTerm Term
hole
  Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
evalTCM (Term
m Term -> [Arg Term] -> Term
forall t. Apply t => t -> [Arg Term] -> t
`apply` [Term -> Arg Term
forall a. a -> Arg a
defaultArg Term
qhole])

evalTCM :: I.Term -> UnquoteM I.Term
evalTCM :: Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
evalTCM Term
v = do
  Term
v <- Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
reduceQuotedTerm Term
v
  TCMT IO ()
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     ()
forall a.
TCM a
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     a
forall (tcm :: * -> *) a. MonadTCM tcm => TCM a -> tcm a
liftTCM (TCMT IO ()
 -> ReaderT
      Context
      (StateT
         UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
      ())
-> TCMT IO ()
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     ()
forall a b. (a -> b) -> a -> b
$ [Char] -> Int -> TCMT IO Doc -> TCMT IO ()
forall (m :: * -> *).
MonadDebug m =>
[Char] -> Int -> TCMT IO Doc -> m ()
reportSDoc [Char]
"tc.unquote.eval" Int
90 (TCMT IO Doc -> TCMT IO ()) -> TCMT IO Doc -> TCMT IO ()
forall a b. (a -> b) -> a -> b
$ TCMT IO Doc
"evalTCM" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> Term -> TCMT IO Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
forall (m :: * -> *). MonadPretty m => Term -> m Doc
prettyTCM Term
v
  let failEval :: ReaderT
  Context
  (StateT
     UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
  Term
failEval = UnquoteError
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
forall a.
UnquoteError
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (UnquoteError
 -> ReaderT
      Context
      (StateT
         UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
      Term)
-> UnquoteError
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
forall a b. (a -> b) -> a -> b
$ [Char] -> Term -> UnquoteError
NonCanonical [Char]
"type checking computation" Term
v

  case Term
v of
    I.Def QName
f [] ->
      [(UnquoteM Bool,
  ReaderT
    Context
    (StateT
       UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
    Term)]
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
forall (m :: * -> *) a. Monad m => [(m Bool, m a)] -> m a -> m a
choice [ (QName
f QName -> TCMT IO Term -> UnquoteM Bool
`isDef` TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primAgdaTCMGetContext,       ReaderT
  Context
  (StateT
     UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
  Term
tcGetContext)
             , (QName
f QName -> TCMT IO Term -> UnquoteM Bool
`isDef` TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primAgdaTCMCommit,           ReaderT
  Context
  (StateT
     UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
  Term
tcCommit)
             ]
             ReaderT
  Context
  (StateT
     UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
  Term
failEval
    I.Def QName
f [Elim
u] ->
      [(UnquoteM Bool,
  ReaderT
    Context
    (StateT
       UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
    Term)]
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
forall (m :: * -> *) a. Monad m => [(m Bool, m a)] -> m a -> m a
choice [ (QName
f QName -> TCMT IO Term -> UnquoteM Bool
`isDef` TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primAgdaTCMInferType,                  (Type -> TCMT IO Term)
-> Elim
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
forall a b. Unquote a => (a -> TCM b) -> Elim -> UnquoteM b
tcFun1 Type -> TCMT IO Term
tcInferType                  Elim
u)
             , (QName
f QName -> TCMT IO Term -> UnquoteM Bool
`isDef` TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primAgdaTCMNormalise,                  (Type -> TCMT IO Term)
-> Elim
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
forall a b. Unquote a => (a -> TCM b) -> Elim -> UnquoteM b
tcFun1 Type -> TCMT IO Term
tcNormalise                  Elim
u)
             , (QName
f QName -> TCMT IO Term -> UnquoteM Bool
`isDef` TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primAgdaTCMReduce,                     (Type -> TCMT IO Term)
-> Elim
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
forall a b. Unquote a => (a -> TCM b) -> Elim -> UnquoteM b
tcFun1 Type -> TCMT IO Term
tcReduce                     Elim
u)
             , (QName
f QName -> TCMT IO Term -> UnquoteM Bool
`isDef` TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primAgdaTCMGetType,                    (QName -> TCMT IO Term)
-> Elim
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
forall a b. Unquote a => (a -> TCM b) -> Elim -> UnquoteM b
tcFun1 QName -> TCMT IO Term
tcGetType                    Elim
u)
             , (QName
f QName -> TCMT IO Term -> UnquoteM Bool
`isDef` TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primAgdaTCMGetDefinition,              (QName -> TCMT IO Term)
-> Elim
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
forall a b. Unquote a => (a -> TCM b) -> Elim -> UnquoteM b
tcFun1 QName -> TCMT IO Term
tcGetDefinition              Elim
u)
             , (QName
f QName -> TCMT IO Term -> UnquoteM Bool
`isDef` TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primAgdaTCMFormatErrorParts,           ([ErrorPart] -> TCMT IO Term)
-> Elim
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
forall a b. Unquote a => (a -> TCM b) -> Elim -> UnquoteM b
tcFun1 [ErrorPart] -> TCMT IO Term
tcFormatErrorParts           Elim
u)
             , (QName
f QName -> TCMT IO Term -> UnquoteM Bool
`isDef` TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primAgdaTCMIsMacro,                    (QName -> TCMT IO Term)
-> Elim
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
forall a b. Unquote a => (a -> TCM b) -> Elim -> UnquoteM b
tcFun1 QName -> TCMT IO Term
tcIsMacro                    Elim
u)
             , (QName
f QName -> TCMT IO Term -> UnquoteM Bool
`isDef` TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primAgdaTCMFreshName,                  (ExeName -> TCMT IO Term)
-> Elim
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
forall a b. Unquote a => (a -> TCM b) -> Elim -> UnquoteM b
tcFun1 ExeName -> TCMT IO Term
tcFreshName                  Elim
u)
             , (QName
f QName -> TCMT IO Term -> UnquoteM Bool
`isDef` TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primAgdaTCMGetInstances,               (MetaId
 -> ReaderT
      Context
      (StateT
         UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
      Term)
-> Elim
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
forall a b. Unquote a => (a -> UnquoteM b) -> Elim -> UnquoteM b
uqFun1 MetaId
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
tcGetInstances               Elim
u)
             ]
             ReaderT
  Context
  (StateT
     UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
  Term
failEval
    I.Def QName
f [Elim
u, Elim
v] ->
      [(UnquoteM Bool,
  ReaderT
    Context
    (StateT
       UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
    Term)]
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
forall (m :: * -> *) a. Monad m => [(m Bool, m a)] -> m a -> m a
choice [ (QName
f QName -> TCMT IO Term -> UnquoteM Bool
`isDef` TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primAgdaTCMUnify,      (Type -> Type -> TCMT IO Term)
-> Elim
-> Elim
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
forall a b c.
(Unquote a, Unquote b) =>
(a -> b -> TCM c) -> Elim -> Elim -> UnquoteM c
tcFun2 Type -> Type -> TCMT IO Term
tcUnify      Elim
u Elim
v)
             , (QName
f QName -> TCMT IO Term -> UnquoteM Bool
`isDef` TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primAgdaTCMCheckType,  (Type -> Type -> TCMT IO Term)
-> Elim
-> Elim
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
forall a b c.
(Unquote a, Unquote b) =>
(a -> b -> TCM c) -> Elim -> Elim -> UnquoteM c
tcFun2 Type -> Type -> TCMT IO Term
tcCheckType  Elim
u Elim
v)
             , (QName
f QName -> TCMT IO Term -> UnquoteM Bool
`isDef` TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primAgdaTCMDeclareDef, (Arg QName
 -> Type
 -> ReaderT
      Context
      (StateT
         UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
      Term)
-> Elim
-> Elim
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
forall a b c.
(Unquote a, Unquote b) =>
(a -> b -> UnquoteM c) -> Elim -> Elim -> UnquoteM c
uqFun2 Arg QName
-> Type
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
tcDeclareDef Elim
u Elim
v)
             , (QName
f QName -> TCMT IO Term -> UnquoteM Bool
`isDef` TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primAgdaTCMDeclarePostulate, (Arg QName
 -> Type
 -> ReaderT
      Context
      (StateT
         UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
      Term)
-> Elim
-> Elim
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
forall a b c.
(Unquote a, Unquote b) =>
(a -> b -> UnquoteM c) -> Elim -> Elim -> UnquoteM c
uqFun2 Arg QName
-> Type
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
tcDeclarePostulate Elim
u Elim
v)
             , (QName
f QName -> TCMT IO Term -> UnquoteM Bool
`isDef` TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primAgdaTCMDefineData, (QName
 -> [(QName, Type)]
 -> ReaderT
      Context
      (StateT
         UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
      Term)
-> Elim
-> Elim
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
forall a b c.
(Unquote a, Unquote b) =>
(a -> b -> UnquoteM c) -> Elim -> Elim -> UnquoteM c
uqFun2 QName
-> [(QName, Type)]
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
tcDefineData Elim
u Elim
v)
             , (QName
f QName -> TCMT IO Term -> UnquoteM Bool
`isDef` TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primAgdaTCMDefineFun,  (QName
 -> [Clause]
 -> ReaderT
      Context
      (StateT
         UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
      Term)
-> Elim
-> Elim
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
forall a b c.
(Unquote a, Unquote b) =>
(a -> b -> UnquoteM c) -> Elim -> Elim -> UnquoteM c
uqFun2 QName
-> [Clause]
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
tcDefineFun  Elim
u Elim
v)
             , (QName
f QName -> TCMT IO Term -> UnquoteM Bool
`isDef` TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primAgdaTCMQuoteOmegaTerm, Type
-> Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
tcQuoteTerm (Sort' Term -> Type
sort (Sort' Term -> Type) -> Sort' Term -> Type
forall a b. (a -> b) -> a -> b
$ IsFibrant -> Integer -> Sort' Term
forall t. IsFibrant -> Integer -> Sort' t
Inf IsFibrant
IsFibrant Integer
0) (Elim -> Term
forall {c}. Elim' c -> c
unElim Elim
v))
             ]
             ReaderT
  Context
  (StateT
     UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
  Term
failEval
    I.Def QName
f [Elim
l, Elim
a, Elim
u] ->
      [(UnquoteM Bool,
  ReaderT
    Context
    (StateT
       UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
    Term)]
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
forall (m :: * -> *) a. Monad m => [(m Bool, m a)] -> m a -> m a
choice [ (QName
f QName -> TCMT IO Term -> UnquoteM Bool
`isDef` TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primAgdaTCMReturn,      Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
forall a.
a
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     a
forall (m :: * -> *) a. Monad m => a -> m a
return (Elim -> Term
forall {c}. Elim' c -> c
unElim Elim
u))
             , (QName
f QName -> TCMT IO Term -> UnquoteM Bool
`isDef` TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primAgdaTCMTypeError,   ([ErrorPart] -> TCMT IO Term)
-> Elim
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
forall a b. Unquote a => (a -> TCM b) -> Elim -> UnquoteM b
tcFun1 [ErrorPart] -> TCMT IO Term
forall a. [ErrorPart] -> TCM a
tcTypeError   Elim
u)
             , (QName
f QName -> TCMT IO Term -> UnquoteM Bool
`isDef` TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primAgdaTCMQuoteTerm,   Type
-> Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
tcQuoteTerm (Term -> Term -> Type
forall {t} {a}. t -> a -> Type'' t a
mkT (Elim -> Term
forall {c}. Elim' c -> c
unElim Elim
l) (Elim -> Term
forall {c}. Elim' c -> c
unElim Elim
a)) (Elim -> Term
forall {c}. Elim' c -> c
unElim Elim
u))
             , (QName
f QName -> TCMT IO Term -> UnquoteM Bool
`isDef` TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primAgdaTCMUnquoteTerm, (Type -> TCMT IO Term)
-> Elim
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
forall a b. Unquote a => (a -> TCM b) -> Elim -> UnquoteM b
tcFun1 (Type -> Type -> TCMT IO Term
tcUnquoteTerm (Term -> Term -> Type
forall {t} {a}. t -> a -> Type'' t a
mkT (Elim -> Term
forall {c}. Elim' c -> c
unElim Elim
l) (Elim -> Term
forall {c}. Elim' c -> c
unElim Elim
a))) Elim
u)
             , (QName
f QName -> TCMT IO Term -> UnquoteM Bool
`isDef` TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primAgdaTCMBlockOnMeta, (MetaId
 -> ReaderT
      Context
      (StateT
         UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
      Term)
-> Elim
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
forall a b. Unquote a => (a -> UnquoteM b) -> Elim -> UnquoteM b
uqFun1 MetaId
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
tcBlockOnMeta Elim
u)
             , (QName
f QName -> TCMT IO Term -> UnquoteM Bool
`isDef` TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primAgdaTCMDebugPrint,  (ExeName -> Integer -> [ErrorPart] -> TCMT IO Term)
-> Elim
-> Elim
-> Elim
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
forall a b c d.
(Unquote a, Unquote b, Unquote c) =>
(a -> b -> c -> TCM d) -> Elim -> Elim -> Elim -> UnquoteM d
tcFun3 ExeName -> Integer -> [ErrorPart] -> TCMT IO Term
tcDebugPrint Elim
l Elim
a Elim
u)
             , (QName
f QName -> TCMT IO Term -> UnquoteM Bool
`isDef` TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primAgdaTCMNoConstraints, Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
tcNoConstraints (Elim -> Term
forall {c}. Elim' c -> c
unElim Elim
u))
             , (QName
f QName -> TCMT IO Term -> UnquoteM Bool
`isDef` TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primAgdaTCMWithReconsParams, Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
tcWithReconsParams (Elim -> Term
forall {c}. Elim' c -> c
unElim Elim
u))
             , (QName
f QName -> TCMT IO Term -> UnquoteM Bool
`isDef` TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primAgdaTCMDeclareData, (QName
 -> Integer
 -> Type
 -> ReaderT
      Context
      (StateT
         UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
      Term)
-> Elim
-> Elim
-> Elim
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
forall a b c d.
(Unquote a, Unquote b, Unquote c) =>
(a -> b -> c -> UnquoteM d) -> Elim -> Elim -> Elim -> UnquoteM d
uqFun3 QName
-> Integer
-> Type
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
tcDeclareData Elim
l Elim
a Elim
u)
             , (QName
f QName -> TCMT IO Term -> UnquoteM Bool
`isDef` TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primAgdaTCMRunSpeculative, Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
tcRunSpeculative (Elim -> Term
forall {c}. Elim' c -> c
unElim Elim
u))
             , (QName
f QName -> TCMT IO Term -> UnquoteM Bool
`isDef` TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primAgdaTCMExec, (ExeName -> [ExeName] -> ExeName -> TCMT IO Term)
-> Elim
-> Elim
-> Elim
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
forall a b c d.
(Unquote a, Unquote b, Unquote c) =>
(a -> b -> c -> TCM d) -> Elim -> Elim -> Elim -> UnquoteM d
tcFun3 ExeName -> [ExeName] -> ExeName -> TCMT IO Term
tcExec Elim
l Elim
a Elim
u)
             ]
             ReaderT
  Context
  (StateT
     UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
  Term
failEval
    I.Def QName
f [Elim
_, Elim
_, Elim
u, Elim
v] ->
      [(UnquoteM Bool,
  ReaderT
    Context
    (StateT
       UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
    Term)]
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
forall (m :: * -> *) a. Monad m => [(m Bool, m a)] -> m a -> m a
choice [ (QName
f QName -> TCMT IO Term -> UnquoteM Bool
`isDef` TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primAgdaTCMCatchError,    Term
-> Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
tcCatchError    (Elim -> Term
forall {c}. Elim' c -> c
unElim Elim
u) (Elim -> Term
forall {c}. Elim' c -> c
unElim Elim
v))
             , (QName
f QName -> TCMT IO Term -> UnquoteM Bool
`isDef` TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primAgdaTCMWithNormalisation, Term
-> Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
tcWithNormalisation (Elim -> Term
forall {c}. Elim' c -> c
unElim Elim
u) (Elim -> Term
forall {c}. Elim' c -> c
unElim Elim
v))
             , (QName
f QName -> TCMT IO Term -> UnquoteM Bool
`isDef` TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primAgdaTCMInContext,     Term
-> Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
tcInContext     (Elim -> Term
forall {c}. Elim' c -> c
unElim Elim
u) (Elim -> Term
forall {c}. Elim' c -> c
unElim Elim
v))
             , (QName
f QName -> TCMT IO Term -> UnquoteM Bool
`isDef` TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primAgdaTCMOnlyReduceDefs, Term
-> Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
tcOnlyReduceDefs (Elim -> Term
forall {c}. Elim' c -> c
unElim Elim
u) (Elim -> Term
forall {c}. Elim' c -> c
unElim Elim
v))
             , (QName
f QName -> TCMT IO Term -> UnquoteM Bool
`isDef` TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primAgdaTCMDontReduceDefs, Term
-> Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
tcDontReduceDefs (Elim -> Term
forall {c}. Elim' c -> c
unElim Elim
u) (Elim -> Term
forall {c}. Elim' c -> c
unElim Elim
v))
             ]
             ReaderT
  Context
  (StateT
     UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
  Term
failEval
    I.Def QName
f [Elim
_, Elim
_, Elim
u, Elim
v, Elim
w] ->
      [(UnquoteM Bool,
  ReaderT
    Context
    (StateT
       UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
    Term)]
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
forall (m :: * -> *) a. Monad m => [(m Bool, m a)] -> m a -> m a
choice [ (QName
f QName -> TCMT IO Term -> UnquoteM Bool
`isDef` TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primAgdaTCMExtendContext, Term
-> Term
-> Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
tcExtendContext (Elim -> Term
forall {c}. Elim' c -> c
unElim Elim
u) (Elim -> Term
forall {c}. Elim' c -> c
unElim Elim
v) (Elim -> Term
forall {c}. Elim' c -> c
unElim Elim
w))
             ]
             ReaderT
  Context
  (StateT
     UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
  Term
failEval
    I.Def QName
f [Elim
_, Elim
_, Elim
_, Elim
_, Elim
m, Elim
k] ->
      [(UnquoteM Bool,
  ReaderT
    Context
    (StateT
       UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
    Term)]
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
forall (m :: * -> *) a. Monad m => [(m Bool, m a)] -> m a -> m a
choice [ (QName
f QName -> TCMT IO Term -> UnquoteM Bool
`isDef` TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primAgdaTCMBind, Term
-> Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
tcBind (Elim -> Term
forall {c}. Elim' c -> c
unElim Elim
m) (Elim -> Term
forall {c}. Elim' c -> c
unElim Elim
k)) ]
             ReaderT
  Context
  (StateT
     UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
  Term
failEval
    Term
_ -> ReaderT
  Context
  (StateT
     UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
  Term
failEval
  where
    unElim :: Elim' c -> c
unElim = Arg c -> c
forall e. Arg e -> e
unArg (Arg c -> c) -> (Elim' c -> Arg c) -> Elim' c -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Arg c -> Maybe (Arg c) -> Arg c
forall a. a -> Maybe a -> a
fromMaybe Arg c
forall a. HasCallStack => a
__IMPOSSIBLE__ (Maybe (Arg c) -> Arg c)
-> (Elim' c -> Maybe (Arg c)) -> Elim' c -> Arg c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Elim' c -> Maybe (Arg c)
forall a. Elim' a -> Maybe (Arg a)
isApplyElim
    tcBind :: Term
-> Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
tcBind Term
m Term
k = do Term
v <- Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
evalTCM Term
m
                    Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
evalTCM (Term
k Term -> [Arg Term] -> Term
forall t. Apply t => t -> [Arg Term] -> t
`apply` [Term -> Arg Term
forall a. a -> Arg a
defaultArg Term
v])

    process :: (InstantiateFull a, Normalise a) => a -> TCM a
    process :: forall a. (InstantiateFull a, Normalise a) => a -> TCM a
process a
v = do
      Bool
norm <- Lens' Bool TCEnv -> TCMT IO Bool
forall (m :: * -> *) a. MonadTCEnv m => Lens' a TCEnv -> m a
viewTC (Bool -> f Bool) -> TCEnv -> f TCEnv
Lens' Bool TCEnv
eUnquoteNormalise
      if Bool
norm then a -> TCM a
forall a (m :: * -> *). (Normalise a, MonadReduce m) => a -> m a
normalise a
v else a -> TCM a
forall a (m :: * -> *).
(InstantiateFull a, MonadReduce m) =>
a -> m a
instantiateFull a
v

    mkT :: t -> a -> Type'' t a
mkT t
l a
a = Sort' t -> a -> Type'' t a
forall t a. Sort' t -> a -> Type'' t a
El Sort' t
s a
a
      where s :: Sort' t
s = Level' t -> Sort' t
forall t. Level' t -> Sort' t
Type (Level' t -> Sort' t) -> Level' t -> Sort' t
forall a b. (a -> b) -> a -> b
$ t -> Level' t
forall t. t -> Level' t
atomicLevel t
l

    -- Don't catch Unquote errors!
    tcCatchError :: Term -> Term -> UnquoteM Term
    tcCatchError :: Term
-> Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
tcCatchError Term
m Term
h =
      (TCM (UnquoteRes Term)
 -> TCM (UnquoteRes Term) -> TCM (UnquoteRes Term))
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
forall a b c.
(TCM (UnquoteRes a) -> TCM (UnquoteRes b) -> TCM (UnquoteRes c))
-> UnquoteM a -> UnquoteM b -> UnquoteM c
liftU2 (\ TCM (UnquoteRes Term)
m1 TCM (UnquoteRes Term)
m2 -> TCM (UnquoteRes Term)
m1 TCM (UnquoteRes Term)
-> (TCErr -> TCM (UnquoteRes Term)) -> TCM (UnquoteRes Term)
forall a. TCMT IO a -> (TCErr -> TCMT IO a) -> TCMT IO a
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
`catchError` \ TCErr
_ -> TCM (UnquoteRes Term)
m2) (Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
evalTCM Term
m) (Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
evalTCM Term
h)

    tcWithNormalisation :: Term -> Term -> UnquoteM Term
    tcWithNormalisation :: Term
-> Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
tcWithNormalisation Term
b Term
m = do
      Bool
v <- Term -> UnquoteM Bool
forall a. Unquote a => Term -> UnquoteM a
unquote Term
b
      (TCM (UnquoteRes Term) -> TCM (UnquoteRes Term))
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
forall a b.
(TCM (UnquoteRes a) -> TCM (UnquoteRes b))
-> UnquoteM a -> UnquoteM b
liftU1 (Lens' Bool TCEnv
-> (Bool -> Bool) -> TCM (UnquoteRes Term) -> TCM (UnquoteRes Term)
forall (m :: * -> *) a b.
MonadTCEnv m =>
Lens' a TCEnv -> (a -> a) -> m b -> m b
locallyTC (Bool -> f Bool) -> TCEnv -> f TCEnv
Lens' Bool TCEnv
eUnquoteNormalise ((Bool -> Bool) -> TCM (UnquoteRes Term) -> TCM (UnquoteRes Term))
-> (Bool -> Bool) -> TCM (UnquoteRes Term) -> TCM (UnquoteRes Term)
forall a b. (a -> b) -> a -> b
$ Bool -> Bool -> Bool
forall a b. a -> b -> a
const Bool
v) (Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
evalTCM Term
m)

    tcOnlyReduceDefs :: Term
-> Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
tcOnlyReduceDefs = (Set QName -> ReduceDefs)
-> Term
-> Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
tcDoReduceDefs Set QName -> ReduceDefs
OnlyReduceDefs
    tcDontReduceDefs :: Term
-> Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
tcDontReduceDefs = (Set QName -> ReduceDefs)
-> Term
-> Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
tcDoReduceDefs Set QName -> ReduceDefs
DontReduceDefs

    tcWithReconsParams :: Term -> UnquoteM Term
    tcWithReconsParams :: Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
tcWithReconsParams Term
m = (TCM (UnquoteRes Term) -> TCM (UnquoteRes Term))
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
forall a b.
(TCM (UnquoteRes a) -> TCM (UnquoteRes b))
-> UnquoteM a -> UnquoteM b
liftU1 TCM (UnquoteRes Term) -> TCM (UnquoteRes Term)
forall (m :: * -> *) a. MonadTCEnv m => m a -> m a
locallyReconstructed (ReaderT
   Context
   (StateT
      UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
   Term
 -> ReaderT
      Context
      (StateT
         UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
      Term)
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
forall a b. (a -> b) -> a -> b
$ Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
evalTCM Term
m

    tcDoReduceDefs :: (Set QName -> ReduceDefs) -> Term -> Term -> UnquoteM Term
    tcDoReduceDefs :: (Set QName -> ReduceDefs)
-> Term
-> Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
tcDoReduceDefs Set QName -> ReduceDefs
reduceDefs Term
v Term
m = do
      [QName]
qs <- Term -> UnquoteM [QName]
forall a. Unquote a => Term -> UnquoteM a
unquote Term
v
      let defs :: ReduceDefs
defs = Set QName -> ReduceDefs
reduceDefs (Set QName -> ReduceDefs) -> Set QName -> ReduceDefs
forall a b. (a -> b) -> a -> b
$ [QName] -> Set QName
forall a. Ord a => [a] -> Set a
Set.fromList [QName]
qs
      (TCM (UnquoteRes Term) -> TCM (UnquoteRes Term))
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
forall a b.
(TCM (UnquoteRes a) -> TCM (UnquoteRes b))
-> UnquoteM a -> UnquoteM b
liftU1 (Lens' ReduceDefs TCEnv
-> (ReduceDefs -> ReduceDefs)
-> TCM (UnquoteRes Term)
-> TCM (UnquoteRes Term)
forall (m :: * -> *) a b.
MonadTCEnv m =>
Lens' a TCEnv -> (a -> a) -> m b -> m b
locallyTC (ReduceDefs -> f ReduceDefs) -> TCEnv -> f TCEnv
Lens' ReduceDefs TCEnv
eReduceDefs (ReduceDefs -> ReduceDefs -> ReduceDefs
forall a. Semigroup a => a -> a -> a
<> ReduceDefs
defs)) (Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
evalTCM Term
m)

    uqFun1 :: Unquote a => (a -> UnquoteM b) -> Elim -> UnquoteM b
    uqFun1 :: forall a b. Unquote a => (a -> UnquoteM b) -> Elim -> UnquoteM b
uqFun1 a -> UnquoteM b
fun Elim
a = do
      a
a <- Term -> UnquoteM a
forall a. Unquote a => Term -> UnquoteM a
unquote (Elim -> Term
forall {c}. Elim' c -> c
unElim Elim
a)
      a -> UnquoteM b
fun a
a

    tcFun1 :: Unquote a => (a -> TCM b) -> Elim -> UnquoteM b
    tcFun1 :: forall a b. Unquote a => (a -> TCM b) -> Elim -> UnquoteM b
tcFun1 a -> TCM b
fun = (a -> UnquoteM b) -> Elim -> UnquoteM b
forall a b. Unquote a => (a -> UnquoteM b) -> Elim -> UnquoteM b
uqFun1 (TCM b -> UnquoteM b
forall a.
TCM a
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     a
forall (tcm :: * -> *) a. MonadTCM tcm => TCM a -> tcm a
liftTCM (TCM b -> UnquoteM b) -> (a -> TCM b) -> a -> UnquoteM b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> TCM b
fun)

    uqFun2 :: (Unquote a, Unquote b) => (a -> b -> UnquoteM c) -> Elim -> Elim -> UnquoteM c
    uqFun2 :: forall a b c.
(Unquote a, Unquote b) =>
(a -> b -> UnquoteM c) -> Elim -> Elim -> UnquoteM c
uqFun2 a -> b -> UnquoteM c
fun Elim
a Elim
b = do
      a
a <- Term -> UnquoteM a
forall a. Unquote a => Term -> UnquoteM a
unquote (Elim -> Term
forall {c}. Elim' c -> c
unElim Elim
a)
      b
b <- Term -> UnquoteM b
forall a. Unquote a => Term -> UnquoteM a
unquote (Elim -> Term
forall {c}. Elim' c -> c
unElim Elim
b)
      a -> b -> UnquoteM c
fun a
a b
b

    uqFun3 :: (Unquote a, Unquote b, Unquote c) => (a -> b -> c -> UnquoteM d) -> Elim -> Elim -> Elim -> UnquoteM d
    uqFun3 :: forall a b c d.
(Unquote a, Unquote b, Unquote c) =>
(a -> b -> c -> UnquoteM d) -> Elim -> Elim -> Elim -> UnquoteM d
uqFun3 a -> b -> c -> UnquoteM d
fun Elim
a Elim
b Elim
c = do
      a
a <- Term -> UnquoteM a
forall a. Unquote a => Term -> UnquoteM a
unquote (Elim -> Term
forall {c}. Elim' c -> c
unElim Elim
a)
      b
b <- Term -> UnquoteM b
forall a. Unquote a => Term -> UnquoteM a
unquote (Elim -> Term
forall {c}. Elim' c -> c
unElim Elim
b)
      c
c <- Term -> UnquoteM c
forall a. Unquote a => Term -> UnquoteM a
unquote (Elim -> Term
forall {c}. Elim' c -> c
unElim Elim
c)
      a -> b -> c -> UnquoteM d
fun a
a b
b c
c

    tcFun2 :: (Unquote a, Unquote b) => (a -> b -> TCM c) -> Elim -> Elim -> UnquoteM c
    tcFun2 :: forall a b c.
(Unquote a, Unquote b) =>
(a -> b -> TCM c) -> Elim -> Elim -> UnquoteM c
tcFun2 a -> b -> TCM c
fun = (a -> b -> UnquoteM c) -> Elim -> Elim -> UnquoteM c
forall a b c.
(Unquote a, Unquote b) =>
(a -> b -> UnquoteM c) -> Elim -> Elim -> UnquoteM c
uqFun2 (\ a
x b
y -> TCM c -> UnquoteM c
forall a.
TCM a
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     a
forall (tcm :: * -> *) a. MonadTCM tcm => TCM a -> tcm a
liftTCM (a -> b -> TCM c
fun a
x b
y))

    tcFun3 :: (Unquote a, Unquote b, Unquote c) => (a -> b -> c -> TCM d) -> Elim -> Elim -> Elim -> UnquoteM d
    tcFun3 :: forall a b c d.
(Unquote a, Unquote b, Unquote c) =>
(a -> b -> c -> TCM d) -> Elim -> Elim -> Elim -> UnquoteM d
tcFun3 a -> b -> c -> TCM d
fun = (a -> b -> c -> UnquoteM d) -> Elim -> Elim -> Elim -> UnquoteM d
forall a b c d.
(Unquote a, Unquote b, Unquote c) =>
(a -> b -> c -> UnquoteM d) -> Elim -> Elim -> Elim -> UnquoteM d
uqFun3 (\ a
x b
y c
z -> TCM d -> UnquoteM d
forall a.
TCM a
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     a
forall (tcm :: * -> *) a. MonadTCM tcm => TCM a -> tcm a
liftTCM (a -> b -> c -> TCM d
fun a
x b
y c
z))

    tcFreshName :: Text -> TCM Term
    tcFreshName :: ExeName -> TCMT IO Term
tcFreshName ExeName
s = do
      TCMT IO Bool -> TCMT IO () -> TCMT IO ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM (Lens' Bool TCEnv -> TCMT IO Bool
forall (m :: * -> *) a. MonadTCEnv m => Lens' a TCEnv -> m a
viewTC (Bool -> f Bool) -> TCEnv -> f TCEnv
Lens' Bool TCEnv
eCurrentlyElaborating) (TCMT IO () -> TCMT IO ()) -> TCMT IO () -> TCMT IO ()
forall a b. (a -> b) -> a -> b
$
        TypeError -> TCMT IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadTCError m) =>
TypeError -> m a
typeError (TypeError -> TCMT IO ()) -> TypeError -> TCMT IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> TypeError
GenericError [Char]
"Not supported: declaring new names from an edit-time macro"
      ModuleName
m <- TCMT IO ModuleName
forall (m :: * -> *). MonadTCEnv m => m ModuleName
currentModule
      QName -> Term
quoteName (QName -> Term) -> (Name -> QName) -> Name -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleName -> Name -> QName
qualify ModuleName
m (Name -> Term) -> TCMT IO Name -> TCMT IO Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> TCMT IO Name
forall a (m :: * -> *).
(FreshName a, MonadFresh NameId m) =>
a -> m Name
forall (m :: * -> *). MonadFresh NameId m => [Char] -> m Name
freshName_ (ExeName -> [Char]
T.unpack ExeName
s)

    tcUnify :: R.Term -> R.Term -> TCM Term
    tcUnify :: Type -> Type -> TCMT IO Term
tcUnify Type
u Type
v = do
      (Term
u, Type
a) <- TCMT IO (Term, Type) -> TCMT IO (Term, Type)
forall (m :: * -> *) a. MonadTCEnv m => m a -> m a
locallyReduceAllDefs (TCMT IO (Term, Type) -> TCMT IO (Term, Type))
-> TCMT IO (Term, Type) -> TCMT IO (Term, Type)
forall a b. (a -> b) -> a -> b
$ Expr -> TCMT IO (Term, Type)
inferExpr        (Expr -> TCMT IO (Term, Type)) -> TCM Expr -> TCMT IO (Term, Type)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Type -> TCMT IO (AbsOfRef Type)
forall r (m :: * -> *).
(ToAbstract r, MonadFresh NameId m, MonadError TCErr m,
 MonadTCEnv m, ReadTCState m, HasOptions m, HasBuiltins m,
 HasConstInfo m) =>
r -> m (AbsOfRef r)
toAbstract_ Type
u
      Term
v      <- TCMT IO Term -> TCMT IO Term
forall (m :: * -> *) a. MonadTCEnv m => m a -> m a
locallyReduceAllDefs (TCMT IO Term -> TCMT IO Term) -> TCMT IO Term -> TCMT IO Term
forall a b. (a -> b) -> a -> b
$ (Expr -> Type -> TCMT IO Term) -> Type -> Expr -> TCMT IO Term
forall a b c. (a -> b -> c) -> b -> a -> c
flip Expr -> Type -> TCMT IO Term
checkExpr Type
a (Expr -> TCMT IO Term) -> TCM Expr -> TCMT IO Term
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Type -> TCMT IO (AbsOfRef Type)
forall r (m :: * -> *).
(ToAbstract r, MonadFresh NameId m, MonadError TCErr m,
 MonadTCEnv m, ReadTCState m, HasOptions m, HasBuiltins m,
 HasConstInfo m) =>
r -> m (AbsOfRef r)
toAbstract_ Type
v
      Type -> Term -> Term -> TCMT IO ()
forall (m :: * -> *).
MonadConversion m =>
Type -> Term -> Term -> m ()
equalTerm Type
a Term
u Term
v
      TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primUnitUnit

    tcBlockOnMeta :: MetaId -> UnquoteM Term
    tcBlockOnMeta :: MetaId
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
tcBlockOnMeta MetaId
x = do
      TCState
s <- (UnquoteState -> TCState)
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     TCState
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets UnquoteState -> TCState
forall a b. (a, b) -> b
snd
      UnquoteError
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
forall a.
UnquoteError
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (TCState -> Blocker -> UnquoteError
BlockedOnMeta TCState
s (Blocker -> UnquoteError) -> Blocker -> UnquoteError
forall a b. (a -> b) -> a -> b
$ MetaId -> Blocker
unblockOnMeta MetaId
x)

    tcCommit :: UnquoteM Term
    tcCommit :: ReaderT
  Context
  (StateT
     UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
  Term
tcCommit = do
      Dirty
dirty <- (UnquoteState -> Dirty)
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Dirty
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets UnquoteState -> Dirty
forall a b. (a, b) -> a
fst
      Bool
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     ()
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Dirty
dirty Dirty -> Dirty -> Bool
forall a. Eq a => a -> a -> Bool
== Dirty
Dirty) (ReaderT
   Context
   (StateT
      UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
   ()
 -> ReaderT
      Context
      (StateT
         UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
      ())
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     ()
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     ()
forall a b. (a -> b) -> a -> b
$
        TCMT IO ()
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     ()
forall a.
TCM a
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     a
forall (tcm :: * -> *) a. MonadTCM tcm => TCM a -> tcm a
liftTCM (TCMT IO ()
 -> ReaderT
      Context
      (StateT
         UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
      ())
-> TCMT IO ()
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     ()
forall a b. (a -> b) -> a -> b
$ TypeError -> TCMT IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadTCError m) =>
TypeError -> m a
typeError (TypeError -> TCMT IO ()) -> TypeError -> TCMT IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> TypeError
GenericError [Char]
"Cannot use commitTC after declaring new definitions."
      TCState
s <- ReaderT
  Context
  (StateT
     UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
  TCState
forall (m :: * -> *). MonadTCState m => m TCState
getTC
      (UnquoteState -> UnquoteState)
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((TCState -> TCState) -> UnquoteState -> UnquoteState
forall b c d. (b -> c) -> (d, b) -> (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second ((TCState -> TCState) -> UnquoteState -> UnquoteState)
-> (TCState -> TCState) -> UnquoteState -> UnquoteState
forall a b. (a -> b) -> a -> b
$ TCState -> TCState -> TCState
forall a b. a -> b -> a
const TCState
s)
      TCMT IO Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
forall a.
TCM a
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     a
forall (tcm :: * -> *) a. MonadTCM tcm => TCM a -> tcm a
liftTCM TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primUnitUnit

    tcFormatErrorParts :: [ErrorPart] -> TCM Term
    tcFormatErrorParts :: [ErrorPart] -> TCMT IO Term
tcFormatErrorParts [ErrorPart]
msg = [Char] -> Term
quoteString ([Char] -> Term) -> (Doc -> [Char]) -> Doc -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Char]
forall a. Pretty a => a -> [Char]
prettyShow (Doc -> Term) -> TCMT IO Doc -> TCMT IO Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ErrorPart] -> TCMT IO Doc
prettyErrorParts [ErrorPart]
msg

    tcTypeError :: [ErrorPart] -> TCM a
    tcTypeError :: forall a. [ErrorPart] -> TCM a
tcTypeError [ErrorPart]
err = TypeError -> TCMT IO a
forall (m :: * -> *) a.
(HasCallStack, MonadTCError m) =>
TypeError -> m a
typeError (TypeError -> TCMT IO a) -> (Doc -> TypeError) -> Doc -> TCMT IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> TypeError
GenericDocError (Doc -> TCMT IO a) -> TCMT IO Doc -> TCMT IO a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [ErrorPart] -> TCMT IO Doc
prettyErrorParts [ErrorPart]
err

    tcDebugPrint :: Text -> Integer -> [ErrorPart] -> TCM Term
    tcDebugPrint :: ExeName -> Integer -> [ErrorPart] -> TCMT IO Term
tcDebugPrint ExeName
s Integer
n [ErrorPart]
msg = do
      [Char] -> Int -> TCMT IO Doc -> TCMT IO ()
forall (m :: * -> *).
MonadDebug m =>
[Char] -> Int -> TCMT IO Doc -> m ()
reportSDoc (ExeName -> [Char]
T.unpack ExeName
s) (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
n) (TCMT IO Doc -> TCMT IO ()) -> TCMT IO Doc -> TCMT IO ()
forall a b. (a -> b) -> a -> b
$ [ErrorPart] -> TCMT IO Doc
prettyErrorParts [ErrorPart]
msg
      TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primUnitUnit

    tcNoConstraints :: Term -> UnquoteM Term
    tcNoConstraints :: Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
tcNoConstraints Term
m = (TCM (UnquoteRes Term) -> TCM (UnquoteRes Term))
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
forall a b.
(TCM (UnquoteRes a) -> TCM (UnquoteRes b))
-> UnquoteM a -> UnquoteM b
liftU1 TCM (UnquoteRes Term) -> TCM (UnquoteRes Term)
forall (m :: * -> *) a.
(MonadConstraint m, MonadWarning m, MonadError TCErr m,
 MonadFresh ProblemId m) =>
m a -> m a
noConstraints (Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
evalTCM Term
m)

    tcInferType :: R.Term -> TCM Term
    tcInferType :: Type -> TCMT IO Term
tcInferType Type
v = do
      Bool
r <- TCMT IO Bool
forall (m :: * -> *). MonadTCEnv m => m Bool
isReconstructed
      (Term
_, Type
a) <- Expr -> TCMT IO (Term, Type)
inferExpr (Expr -> TCMT IO (Term, Type)) -> TCM Expr -> TCMT IO (Term, Type)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Type -> TCMT IO (AbsOfRef Type)
forall r (m :: * -> *).
(ToAbstract r, MonadFresh NameId m, MonadError TCErr m,
 MonadTCEnv m, ReadTCState m, HasOptions m, HasBuiltins m,
 HasConstInfo m) =>
r -> m (AbsOfRef r)
toAbstract_ Type
v
      if Bool
r then do
        Type
a <- Type -> TCM Type
forall a. (InstantiateFull a, Normalise a) => a -> TCM a
process Type
a
        Type
a <- TCM Type -> TCM Type
forall (m :: * -> *) a. MonadTCEnv m => m a -> m a
locallyReduceAllDefs (TCM Type -> TCM Type) -> TCM Type -> TCM Type
forall a b. (a -> b) -> a -> b
$ Type -> TCM Type
reconstructParametersInType Type
a
        [Char] -> Int -> TCMT IO Doc -> TCMT IO ()
forall (m :: * -> *).
MonadDebug m =>
[Char] -> Int -> TCMT IO Doc -> m ()
reportSDoc [Char]
"tc.reconstruct" Int
50 (TCMT IO Doc -> TCMT IO ()) -> TCMT IO Doc -> TCMT IO ()
forall a b. (a -> b) -> a -> b
$ TCMT IO Doc
"Infer after reconstruct:"
          TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> Type -> TCMT IO Doc
forall (m :: * -> *) a. (Applicative m, Pretty a) => a -> m Doc
pretty Type
a
        TCMT IO Term -> TCMT IO Term
forall (m :: * -> *) a. MonadTCEnv m => m a -> m a
locallyReconstructed (Type -> TCMT IO Term
quoteType Type
a)
      else
        Type -> TCMT IO Term
quoteType (Type -> TCMT IO Term) -> TCM Type -> TCMT IO Term
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Type -> TCM Type
forall a. (InstantiateFull a, Normalise a) => a -> TCM a
process Type
a

    tcCheckType :: R.Term -> R.Type -> TCM Term
    tcCheckType :: Type -> Type -> TCMT IO Term
tcCheckType Type
v Type
a = do
      Bool
r <- TCMT IO Bool
forall (m :: * -> *). MonadTCEnv m => m Bool
isReconstructed
      Type
a <- TCM Type -> TCM Type
forall (m :: * -> *) a.
(MonadTCEnv m, HasOptions m, MonadDebug m) =>
m a -> m a
workOnTypes (TCM Type -> TCM Type) -> TCM Type -> TCM Type
forall a b. (a -> b) -> a -> b
$ TCM Type -> TCM Type
forall (m :: * -> *) a. MonadTCEnv m => m a -> m a
locallyReduceAllDefs (TCM Type -> TCM Type) -> TCM Type -> TCM Type
forall a b. (a -> b) -> a -> b
$ Expr -> TCM Type
isType_ (Expr -> TCM Type) -> TCM Expr -> TCM Type
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Type -> TCMT IO (AbsOfRef Type)
forall r (m :: * -> *).
(ToAbstract r, MonadFresh NameId m, MonadError TCErr m,
 MonadTCEnv m, ReadTCState m, HasOptions m, HasBuiltins m,
 HasConstInfo m) =>
r -> m (AbsOfRef r)
toAbstract_ Type
a
      Expr
e <- Type -> TCMT IO (AbsOfRef Type)
forall r (m :: * -> *).
(ToAbstract r, MonadFresh NameId m, MonadError TCErr m,
 MonadTCEnv m, ReadTCState m, HasOptions m, HasBuiltins m,
 HasConstInfo m) =>
r -> m (AbsOfRef r)
toAbstract_ Type
v
      Term
v <- Expr -> Type -> TCMT IO Term
checkExpr Expr
e Type
a
      if Bool
r then do
        Term
v <- Term -> TCMT IO Term
forall a. (InstantiateFull a, Normalise a) => a -> TCM a
process Term
v
        Term
v <- TCMT IO Term -> TCMT IO Term
forall (m :: * -> *) a. MonadTCEnv m => m a -> m a
locallyReduceAllDefs (TCMT IO Term -> TCMT IO Term) -> TCMT IO Term -> TCMT IO Term
forall a b. (a -> b) -> a -> b
$ Type -> Term -> TCMT IO Term
reconstructParameters Type
a Term
v
        TCMT IO Term -> TCMT IO Term
forall (m :: * -> *) a. MonadTCEnv m => m a -> m a
locallyReconstructed (Term -> TCMT IO Term
quoteTerm Term
v)
      else
        Term -> TCMT IO Term
quoteTerm (Term -> TCMT IO Term) -> TCMT IO Term -> TCMT IO Term
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Term -> TCMT IO Term
forall a. (InstantiateFull a, Normalise a) => a -> TCM a
process Term
v

    tcQuoteTerm :: Type -> Term -> UnquoteM Term
    tcQuoteTerm :: Type
-> Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
tcQuoteTerm Type
a Term
v = TCMT IO Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
forall a.
TCM a
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     a
forall (tcm :: * -> *) a. MonadTCM tcm => TCM a -> tcm a
liftTCM (TCMT IO Term
 -> ReaderT
      Context
      (StateT
         UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
      Term)
-> TCMT IO Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
forall a b. (a -> b) -> a -> b
$ do
      Bool
r <- TCMT IO Bool
forall (m :: * -> *). MonadTCEnv m => m Bool
isReconstructed
      if Bool
r then do
        Term
v <- Term -> TCMT IO Term
forall a. (InstantiateFull a, Normalise a) => a -> TCM a
process Term
v
        Term
v <- TCMT IO Term -> TCMT IO Term
forall (m :: * -> *) a. MonadTCEnv m => m a -> m a
locallyReduceAllDefs (TCMT IO Term -> TCMT IO Term) -> TCMT IO Term -> TCMT IO Term
forall a b. (a -> b) -> a -> b
$ Type -> Term -> TCMT IO Term
reconstructParameters Type
a Term
v
        TCMT IO Term -> TCMT IO Term
forall (m :: * -> *) a. MonadTCEnv m => m a -> m a
locallyReconstructed (Term -> TCMT IO Term
quoteTerm Term
v)
      else
        Term -> TCMT IO Term
quoteTerm (Term -> TCMT IO Term) -> TCMT IO Term -> TCMT IO Term
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Term -> TCMT IO Term
forall a. (InstantiateFull a, Normalise a) => a -> TCM a
process Term
v

    tcUnquoteTerm :: Type -> R.Term -> TCM Term
    tcUnquoteTerm :: Type -> Type -> TCMT IO Term
tcUnquoteTerm Type
a Type
v = do
      Expr
e <- Type -> TCMT IO (AbsOfRef Type)
forall r (m :: * -> *).
(ToAbstract r, MonadFresh NameId m, MonadError TCErr m,
 MonadTCEnv m, ReadTCState m, HasOptions m, HasBuiltins m,
 HasConstInfo m) =>
r -> m (AbsOfRef r)
toAbstract_ Type
v
      Expr -> Type -> TCMT IO Term
checkExpr Expr
e Type
a

    tcNormalise :: R.Term -> TCM Term
    tcNormalise :: Type -> TCMT IO Term
tcNormalise Type
v = do
      Bool
r <- TCMT IO Bool
forall (m :: * -> *). MonadTCEnv m => m Bool
isReconstructed
      (Term
v, Type
t) <- TCMT IO (Term, Type) -> TCMT IO (Term, Type)
forall (m :: * -> *) a. MonadTCEnv m => m a -> m a
locallyReduceAllDefs (TCMT IO (Term, Type) -> TCMT IO (Term, Type))
-> TCMT IO (Term, Type) -> TCMT IO (Term, Type)
forall a b. (a -> b) -> a -> b
$ Expr -> TCMT IO (Term, Type)
inferExpr  (Expr -> TCMT IO (Term, Type)) -> TCM Expr -> TCMT IO (Term, Type)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Type -> TCMT IO (AbsOfRef Type)
forall r (m :: * -> *).
(ToAbstract r, MonadFresh NameId m, MonadError TCErr m,
 MonadTCEnv m, ReadTCState m, HasOptions m, HasBuiltins m,
 HasConstInfo m) =>
r -> m (AbsOfRef r)
toAbstract_ Type
v
      if Bool
r then do
        Term
v <- Term -> TCMT IO Term
forall a (m :: * -> *). (Normalise a, MonadReduce m) => a -> m a
normalise Term
v
        Type
t <- Type -> TCM Type
forall a (m :: * -> *). (Normalise a, MonadReduce m) => a -> m a
normalise Type
t
        Term
v <- TCMT IO Term -> TCMT IO Term
forall (m :: * -> *) a. MonadTCEnv m => m a -> m a
locallyReduceAllDefs (TCMT IO Term -> TCMT IO Term) -> TCMT IO Term -> TCMT IO Term
forall a b. (a -> b) -> a -> b
$ Action (TCMT IO) -> Type -> Term -> TCMT IO Term
reconstructParameters' Action (TCMT IO)
forall (m :: * -> *). PureTCM m => Action m
defaultAction Type
t Term
v
        [Char] -> Int -> TCMT IO Doc -> TCMT IO ()
forall (m :: * -> *).
MonadDebug m =>
[Char] -> Int -> TCMT IO Doc -> m ()
reportSDoc [Char]
"tc.reconstruct" Int
50 (TCMT IO Doc -> TCMT IO ()) -> TCMT IO Doc -> TCMT IO ()
forall a b. (a -> b) -> a -> b
$ TCMT IO Doc
"Normalise reconstruct:" 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
        TCMT IO Term -> TCMT IO Term
forall (m :: * -> *) a. MonadTCEnv m => m a -> m a
locallyReconstructed (TCMT IO Term -> TCMT IO Term) -> TCMT IO Term -> TCMT IO Term
forall a b. (a -> b) -> a -> b
$ Term -> TCMT IO Term
quoteTerm Term
v
      else
       Term -> TCMT IO Term
quoteTerm (Term -> TCMT IO Term) -> TCMT IO Term -> TCMT IO Term
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Term -> TCMT IO Term
forall a (m :: * -> *). (Normalise a, MonadReduce m) => a -> m a
normalise Term
v

    tcReduce :: R.Term -> TCM Term
    tcReduce :: Type -> TCMT IO Term
tcReduce Type
v = do
      Bool
r <- TCMT IO Bool
forall (m :: * -> *). MonadTCEnv m => m Bool
isReconstructed
      (Term
v, Type
t) <- TCMT IO (Term, Type) -> TCMT IO (Term, Type)
forall (m :: * -> *) a. MonadTCEnv m => m a -> m a
locallyReduceAllDefs (TCMT IO (Term, Type) -> TCMT IO (Term, Type))
-> TCMT IO (Term, Type) -> TCMT IO (Term, Type)
forall a b. (a -> b) -> a -> b
$ Expr -> TCMT IO (Term, Type)
inferExpr (Expr -> TCMT IO (Term, Type)) -> TCM Expr -> TCMT IO (Term, Type)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Type -> TCMT IO (AbsOfRef Type)
forall r (m :: * -> *).
(ToAbstract r, MonadFresh NameId m, MonadError TCErr m,
 MonadTCEnv m, ReadTCState m, HasOptions m, HasBuiltins m,
 HasConstInfo m) =>
r -> m (AbsOfRef r)
toAbstract_ Type
v
      if Bool
r then do
        Term
v <- Term -> TCMT IO Term
forall a (m :: * -> *). (Reduce a, MonadReduce m) => a -> m a
reduce (Term -> TCMT IO Term) -> TCMT IO Term -> TCMT IO Term
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Term -> TCMT IO Term
forall a (m :: * -> *).
(InstantiateFull a, MonadReduce m) =>
a -> m a
instantiateFull Term
v
        Type
t <- Type -> TCM Type
forall a (m :: * -> *). (Reduce a, MonadReduce m) => a -> m a
reduce (Type -> TCM Type) -> TCM Type -> TCM Type
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Type -> TCM Type
forall a (m :: * -> *).
(InstantiateFull a, MonadReduce m) =>
a -> m a
instantiateFull Type
t
        Term
v <- TCMT IO Term -> TCMT IO Term
forall (m :: * -> *) a. MonadTCEnv m => m a -> m a
locallyReduceAllDefs (TCMT IO Term -> TCMT IO Term) -> TCMT IO Term -> TCMT IO Term
forall a b. (a -> b) -> a -> b
$ Action (TCMT IO) -> Type -> Term -> TCMT IO Term
reconstructParameters' Action (TCMT IO)
forall (m :: * -> *). PureTCM m => Action m
defaultAction Type
t Term
v
        [Char] -> Int -> TCMT IO Doc -> TCMT IO ()
forall (m :: * -> *).
MonadDebug m =>
[Char] -> Int -> TCMT IO Doc -> m ()
reportSDoc [Char]
"tc.reconstruct" Int
50 (TCMT IO Doc -> TCMT IO ()) -> TCMT IO Doc -> TCMT IO ()
forall a b. (a -> b) -> a -> b
$ TCMT IO Doc
"Reduce reconstruct:" 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
        TCMT IO Term -> TCMT IO Term
forall (m :: * -> *) a. MonadTCEnv m => m a -> m a
locallyReconstructed (TCMT IO Term -> TCMT IO Term) -> TCMT IO Term -> TCMT IO Term
forall a b. (a -> b) -> a -> b
$ Term -> TCMT IO Term
quoteTerm Term
v
      else
        Term -> TCMT IO Term
quoteTerm (Term -> TCMT IO Term) -> TCMT IO Term -> TCMT IO Term
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Term -> TCMT IO Term
forall a (m :: * -> *). (Reduce a, MonadReduce m) => a -> m a
reduce (Term -> TCMT IO Term) -> TCMT IO Term -> TCMT IO Term
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Term -> TCMT IO Term
forall a (m :: * -> *).
(InstantiateFull a, MonadReduce m) =>
a -> m a
instantiateFull Term
v

    tcGetContext :: UnquoteM Term
    tcGetContext :: ReaderT
  Context
  (StateT
     UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
  Term
tcGetContext = TCMT IO Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
forall a.
TCM a
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     a
forall (tcm :: * -> *) a. MonadTCM tcm => TCM a -> tcm a
liftTCM (TCMT IO Term
 -> ReaderT
      Context
      (StateT
         UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
      Term)
-> TCMT IO Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
forall a b. (a -> b) -> a -> b
$ do
      Bool
r <- TCMT IO Bool
forall (m :: * -> *). MonadTCEnv m => m Bool
isReconstructed
      [([Char], Dom Type)]
as <- (ContextEntry -> ([Char], Dom Type))
-> Context -> [([Char], Dom Type)]
forall a b. (a -> b) -> [a] -> [b]
map (Name -> [Char]
nameToArgName (Name -> [Char])
-> (ContextEntry -> Name) -> ContextEntry -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name, Type) -> Name
forall a b. (a, b) -> a
fst ((Name, Type) -> Name)
-> (ContextEntry -> (Name, Type)) -> ContextEntry -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContextEntry -> (Name, Type)
forall t e. Dom' t e -> e
unDom (ContextEntry -> [Char])
-> (ContextEntry -> Dom Type) -> ContextEntry -> ([Char], Dom Type)
forall b c c'. (b -> c) -> (b -> c') -> b -> (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& ((Name, Type) -> Type) -> ContextEntry -> Dom Type
forall a b. (a -> b) -> Dom' Term a -> Dom' Term b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Name, Type) -> Type
forall a b. (a, b) -> b
snd) (Context -> [([Char], Dom Type)])
-> TCMT IO Context -> TCMT IO [([Char], Dom Type)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TCMT IO Context
forall (m :: * -> *). MonadTCEnv m => m Context
getContext
      [([Char], Dom Type)]
as <- [([Char], Dom Type)] -> TCMT IO [([Char], Dom Type)]
forall (m :: * -> *) a.
(MonadTCEnv m, HasConstInfo m, HasOptions m, TermLike a) =>
a -> m a
etaContract ([([Char], Dom Type)] -> TCMT IO [([Char], Dom Type)])
-> TCMT IO [([Char], Dom Type)] -> TCMT IO [([Char], Dom Type)]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [([Char], Dom Type)] -> TCMT IO [([Char], Dom Type)]
forall a. (InstantiateFull a, Normalise a) => a -> TCM a
process [([Char], Dom Type)]
as
      if Bool
r then do
        [([Char], Dom Type)]
as <- [([Char], Dom Type)] -> TCMT IO [([Char], Dom Type)]
recons ([([Char], Dom Type)] -> [([Char], Dom Type)]
forall a. [a] -> [a]
reverse [([Char], Dom Type)]
as)
        let as' :: [([Char], Dom Type)]
as' = [([Char], Dom Type)] -> [([Char], Dom Type)]
forall a. [a] -> [a]
reverse [([Char], Dom Type)]
as
        TCMT IO Term -> TCMT IO Term
forall (m :: * -> *) a. MonadTCEnv m => m a -> m a
locallyReconstructed (TCMT IO Term -> TCMT IO Term) -> TCMT IO Term -> TCMT IO Term
forall a b. (a -> b) -> a -> b
$ TCM ([Term] -> Term)
buildList TCM ([Term] -> Term) -> TCMT IO [Term] -> TCMT IO Term
forall a b. TCMT IO (a -> b) -> TCMT IO a -> TCMT IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (([Char], Dom Type) -> TCMT IO Term)
-> [([Char], Dom Type)] -> TCMT IO [Term]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ([Char], Dom Type) -> TCMT IO Term
quoteDomWithName [([Char], Dom Type)]
as'
      else
        TCM ([Term] -> Term)
buildList TCM ([Term] -> Term) -> TCMT IO [Term] -> TCMT IO Term
forall a b. TCMT IO (a -> b) -> TCMT IO a -> TCMT IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (([Char], Dom Type) -> TCMT IO Term)
-> [([Char], Dom Type)] -> TCMT IO [Term]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ([Char], Dom Type) -> TCMT IO Term
quoteDomWithName [([Char], Dom Type)]
as
      where
        recons :: [(ArgName, Dom Type)] -> TCM [(ArgName, Dom Type)]
        recons :: [([Char], Dom Type)] -> TCMT IO [([Char], Dom Type)]
recons []                        = [([Char], Dom Type)] -> TCMT IO [([Char], Dom Type)]
forall a. a -> TCMT IO a
forall (m :: * -> *) a. Monad m => a -> m a
return []
        recons (([Char]
s, d :: Dom Type
d@Dom {unDom :: forall t e. Dom' t e -> e
unDom=Type
t}):[([Char], Dom Type)]
ds) = do
          Type
t <- TCM Type -> TCM Type
forall (m :: * -> *) a. MonadTCEnv m => m a -> m a
locallyReduceAllDefs (TCM Type -> TCM Type) -> TCM Type -> TCM Type
forall a b. (a -> b) -> a -> b
$ Type -> TCM Type
reconstructParametersInType Type
t
          let d' :: Dom Type
d' = Dom Type
d{unDom :: Type
unDom=Type
t}
          [([Char], Dom Type)]
ds' <- ([Char], Dom Type)
-> TCMT IO [([Char], Dom Type)] -> TCMT IO [([Char], Dom Type)]
forall b (m :: * -> *) a.
(AddContext b, MonadAddContext m) =>
b -> m a -> m a
forall (m :: * -> *) a.
MonadAddContext m =>
([Char], Dom Type) -> m a -> m a
addContext ([Char]
s, Dom Type
d') (TCMT IO [([Char], Dom Type)] -> TCMT IO [([Char], Dom Type)])
-> TCMT IO [([Char], Dom Type)] -> TCMT IO [([Char], Dom Type)]
forall a b. (a -> b) -> a -> b
$ [([Char], Dom Type)] -> TCMT IO [([Char], Dom Type)]
recons [([Char], Dom Type)]
ds
          [([Char], Dom Type)] -> TCMT IO [([Char], Dom Type)]
forall a. a -> TCMT IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([([Char], Dom Type)] -> TCMT IO [([Char], Dom Type)])
-> [([Char], Dom Type)] -> TCMT IO [([Char], Dom Type)]
forall a b. (a -> b) -> a -> b
$ ([Char]
s, Dom Type
d')([Char], Dom Type) -> [([Char], Dom Type)] -> [([Char], Dom Type)]
forall a. a -> [a] -> [a]
:[([Char], Dom Type)]
ds'

        quoteDomWithName :: (ArgName, Dom Type) -> TCM Term
        quoteDomWithName :: ([Char], Dom Type) -> TCMT IO Term
quoteDomWithName ([Char]
x, Dom Type
t) = TCM ((ExeName, Dom Type) -> Term)
forall a. ToTerm a => TCM (a -> Term)
toTerm TCM ((ExeName, Dom Type) -> Term)
-> TCMT IO (ExeName, Dom Type) -> TCMT IO Term
forall a b. TCMT IO (a -> b) -> TCMT IO a -> TCMT IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (ExeName, Dom Type) -> TCMT IO (ExeName, Dom Type)
forall a. a -> TCMT IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Char] -> ExeName
T.pack [Char]
x, Dom Type
t)

    extendCxt :: Text -> Arg R.Type -> UnquoteM a -> UnquoteM a
    extendCxt :: forall a. ExeName -> Arg Type -> UnquoteM a -> UnquoteM a
extendCxt ExeName
s Arg Type
a UnquoteM a
m = do
      Arg Type
a <- ReaderT
  Context
  (StateT
     UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
  (Arg Type)
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     (Arg Type)
forall (m :: * -> *) a.
(MonadTCEnv m, HasOptions m, MonadDebug m) =>
m a -> m a
workOnTypes (ReaderT
   Context
   (StateT
      UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
   (Arg Type)
 -> ReaderT
      Context
      (StateT
         UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
      (Arg Type))
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     (Arg Type)
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     (Arg Type)
forall a b. (a -> b) -> a -> b
$ ReaderT
  Context
  (StateT
     UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
  (Arg Type)
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     (Arg Type)
forall (m :: * -> *) a. MonadTCEnv m => m a -> m a
locallyReduceAllDefs (ReaderT
   Context
   (StateT
      UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
   (Arg Type)
 -> ReaderT
      Context
      (StateT
         UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
      (Arg Type))
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     (Arg Type)
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     (Arg Type)
forall a b. (a -> b) -> a -> b
$ TCM (Arg Type)
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     (Arg Type)
forall a.
TCM a
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     a
forall (tcm :: * -> *) a. MonadTCM tcm => TCM a -> tcm a
liftTCM (TCM (Arg Type)
 -> ReaderT
      Context
      (StateT
         UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
      (Arg Type))
-> TCM (Arg Type)
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     (Arg Type)
forall a b. (a -> b) -> a -> b
$ (Type -> TCM Type) -> Arg Type -> TCM (Arg Type)
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 (Expr -> TCM Type
isType_ (Expr -> TCM Type) -> (Type -> TCM Expr) -> Type -> TCM Type
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Type -> TCM Expr
Type -> TCMT IO (AbsOfRef Type)
forall r (m :: * -> *).
(ToAbstract r, MonadFresh NameId m, MonadError TCErr m,
 MonadTCEnv m, ReadTCState m, HasOptions m, HasBuiltins m,
 HasConstInfo m) =>
r -> m (AbsOfRef r)
toAbstract_) Arg Type
a
      (TCM (UnquoteRes a) -> TCM (UnquoteRes a))
-> UnquoteM a -> UnquoteM a
forall a b.
(TCM (UnquoteRes a) -> TCM (UnquoteRes b))
-> UnquoteM a -> UnquoteM b
liftU1 ((ExeName, Dom Type) -> TCM (UnquoteRes a) -> TCM (UnquoteRes a)
forall b (m :: * -> *) a.
(AddContext b, MonadAddContext m) =>
b -> m a -> m a
forall (m :: * -> *) a.
MonadAddContext m =>
(ExeName, Dom Type) -> m a -> m a
addContext (ExeName
s, Arg Type -> Dom Type
forall a. Arg a -> Dom a
domFromArg Arg Type
a :: Dom Type)) UnquoteM a
m

    tcExtendContext :: Term -> Term -> Term -> UnquoteM Term
    tcExtendContext :: Term
-> Term
-> Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
tcExtendContext Term
s Term
a Term
m = do
      ExeName
s <- Term -> UnquoteM ExeName
forall a. Unquote a => Term -> UnquoteM a
unquote Term
s
      Arg Type
a <- Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     (Arg Type)
forall a. Unquote a => Term -> UnquoteM a
unquote Term
a
      (Term -> Term)
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
forall a b.
(a -> b)
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     a
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Impossible -> Term -> Term
forall a. Subst a => Impossible -> a -> a
strengthen Impossible
HasCallStack => Impossible
impossible) (ReaderT
   Context
   (StateT
      UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
   Term
 -> ReaderT
      Context
      (StateT
         UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
      Term)
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
forall a b. (a -> b) -> a -> b
$ ExeName
-> Arg Type
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
forall a. ExeName -> Arg Type -> UnquoteM a -> UnquoteM a
extendCxt ExeName
s Arg Type
a (ReaderT
   Context
   (StateT
      UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
   Term
 -> ReaderT
      Context
      (StateT
         UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
      Term)
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
forall a b. (a -> b) -> a -> b
$ do
        Term
v <- Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
evalTCM (Term
 -> ReaderT
      Context
      (StateT
         UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
      Term)
-> Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
forall a b. (a -> b) -> a -> b
$ Int -> Term -> Term
forall a. Subst a => Int -> a -> a
raise Int
1 Term
m
        Bool
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     ()
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int -> Term -> Bool
forall a. Free a => Int -> a -> Bool
freeIn Int
0 Term
v) (ReaderT
   Context
   (StateT
      UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
   ()
 -> ReaderT
      Context
      (StateT
         UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
      ())
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     ()
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     ()
forall a b. (a -> b) -> a -> b
$ TCMT IO ()
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     ()
forall a.
TCM a
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     a
forall (tcm :: * -> *) a. MonadTCM tcm => TCM a -> tcm a
liftTCM (TCMT IO ()
 -> ReaderT
      Context
      (StateT
         UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
      ())
-> TCMT IO ()
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     ()
forall a b. (a -> b) -> a -> b
$ Doc -> TCMT IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadTCError m) =>
Doc -> m a
genericDocError (Doc -> TCMT IO ()) -> TCMT IO Doc -> TCMT IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
          [TCMT IO Doc] -> TCMT IO Doc
forall (m :: * -> *) (t :: * -> *).
(Applicative m, Foldable t) =>
t (m Doc) -> m Doc
hcat [TCMT IO Doc
"Local variable '", Term -> TCMT IO Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
forall (m :: * -> *). MonadPretty m => Term -> m Doc
prettyTCM (Int -> Term
var Int
0), TCMT IO Doc
"' escaping in result of extendContext:"]
            TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<?> Term -> TCMT IO Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
forall (m :: * -> *). MonadPretty m => Term -> m Doc
prettyTCM Term
v
        Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
forall a.
a
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     a
forall (m :: * -> *) a. Monad m => a -> m a
return Term
v

    tcInContext :: Term -> Term -> UnquoteM Term
    tcInContext :: Term
-> Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
tcInContext Term
c Term
m = do
      [(ExeName, Arg Type)]
c <- Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     [(ExeName, Arg Type)]
forall a. Unquote a => Term -> UnquoteM a
unquote Term
c
      ReaderT
  Context
  (StateT
     UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
  Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
forall a. UnquoteM a -> UnquoteM a
inOriginalContext (ReaderT
   Context
   (StateT
      UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
   Term
 -> ReaderT
      Context
      (StateT
         UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
      Term)
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
forall a b. (a -> b) -> a -> b
$ [(ExeName, Arg Type)]
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
go [(ExeName, Arg Type)]
c (Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
evalTCM Term
m)
      where
        go :: [(Text , Arg R.Type)] -> UnquoteM Term -> UnquoteM Term
        go :: [(ExeName, Arg Type)]
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
go []             ReaderT
  Context
  (StateT
     UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
  Term
m = ReaderT
  Context
  (StateT
     UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
  Term
m
        go ((ExeName
s , Arg Type
a) : [(ExeName, Arg Type)]
as) ReaderT
  Context
  (StateT
     UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
  Term
m = [(ExeName, Arg Type)]
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
go [(ExeName, Arg Type)]
as (ExeName
-> Arg Type
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
forall a. ExeName -> Arg Type -> UnquoteM a -> UnquoteM a
extendCxt ExeName
s Arg Type
a ReaderT
  Context
  (StateT
     UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
  Term
m)

    constInfo :: QName -> TCM Definition
    constInfo :: QName -> TCM Definition
constInfo QName
x = (SigError -> TCM Definition)
-> (Definition -> TCM Definition)
-> Either SigError Definition
-> TCM Definition
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either SigError -> TCM Definition
err Definition -> TCM Definition
forall a. a -> TCMT IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either SigError Definition -> TCM Definition)
-> TCMT IO (Either SigError Definition) -> TCM Definition
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< QName -> TCMT IO (Either SigError Definition)
forall (m :: * -> *).
HasConstInfo m =>
QName -> m (Either SigError Definition)
getConstInfo' QName
x
      where err :: SigError -> TCM Definition
err SigError
_ = [Char] -> TCM Definition
forall (m :: * -> *) a.
(HasCallStack, MonadTCError m) =>
[Char] -> m a
genericError ([Char] -> TCM Definition) -> [Char] -> TCM Definition
forall a b. (a -> b) -> a -> b
$ [Char]
"Unbound name: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ QName -> [Char]
forall a. Pretty a => a -> [Char]
prettyShow QName
x

    tcGetType :: QName -> TCM Term
    tcGetType :: QName -> TCMT IO Term
tcGetType QName
x = do
      Bool
r  <- TCMT IO Bool
forall (m :: * -> *). MonadTCEnv m => m Bool
isReconstructed
      Definition
ci <- QName -> TCM Definition
constInfo QName
x TCM Definition -> (Definition -> TCM Definition) -> TCM Definition
forall a b. TCMT IO a -> (a -> TCMT IO b) -> TCMT IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Definition -> TCM Definition
forall (m :: * -> *).
(Functor m, HasConstInfo m, HasOptions m, ReadTCState m,
 MonadTCEnv m, MonadDebug m) =>
Definition -> m Definition
instantiateDef
      let t :: Type
t = Definition -> Type
defType Definition
ci
      if Bool
r then do
        Type
t <- TCM Type -> TCM Type
forall (m :: * -> *) a. MonadTCEnv m => m a -> m a
locallyReduceAllDefs (TCM Type -> TCM Type) -> TCM Type -> TCM Type
forall a b. (a -> b) -> a -> b
$ Type -> TCM Type
reconstructParametersInType Type
t
        Type -> TCMT IO Term
quoteType Type
t
      else
        Type -> TCMT IO Term
quoteType Type
t


    tcIsMacro :: QName -> TCM Term
    tcIsMacro :: QName -> TCMT IO Term
tcIsMacro QName
x = do
      Term
true  <- TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primTrue
      Term
false <- TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primFalse
      let qBool :: Bool -> Term
qBool Bool
True  = Term
true
          qBool Bool
False = Term
false
      Bool -> Term
qBool (Bool -> Term) -> (Definition -> Bool) -> Definition -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Defn -> Bool
isMacro (Defn -> Bool) -> (Definition -> Defn) -> Definition -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Definition -> Defn
theDef (Definition -> Term) -> TCM Definition -> TCMT IO Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> QName -> TCM Definition
constInfo QName
x

    tcGetDefinition :: QName -> TCM Term
    tcGetDefinition :: QName -> TCMT IO Term
tcGetDefinition QName
x = do
      Bool
r <- TCMT IO Bool
forall (m :: * -> *). MonadTCEnv m => m Bool
isReconstructed
      if Bool
r then
        QName -> TCMT IO Term
tcGetDefinitionRecons QName
x
      else
        Definition -> TCMT IO Term
quoteDefn (Definition -> TCMT IO Term) -> TCM Definition -> TCMT IO Term
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Definition -> TCM Definition
forall (m :: * -> *).
(Functor m, HasConstInfo m, HasOptions m, ReadTCState m,
 MonadTCEnv m, MonadDebug m) =>
Definition -> m Definition
instantiateDef (Definition -> TCM Definition) -> TCM Definition -> TCM Definition
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< QName -> TCM Definition
constInfo QName
x

    tcGetDefinitionRecons :: QName -> TCM Term
    tcGetDefinitionRecons :: QName -> TCMT IO Term
tcGetDefinitionRecons QName
x = do
      ci :: Definition
ci@(Defn {theDef :: Definition -> Defn
theDef=Defn
d}) <- QName -> TCM Definition
constInfo QName
x TCM Definition -> (Definition -> TCM Definition) -> TCM Definition
forall a b. TCMT IO a -> (a -> TCMT IO b) -> TCMT IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Definition -> TCM Definition
forall (m :: * -> *).
(Functor m, HasConstInfo m, HasOptions m, ReadTCState m,
 MonadTCEnv m, MonadDebug m) =>
Definition -> m Definition
instantiateDef
      case Defn
d of
        f :: Defn
f@(Function {funClauses :: Defn -> [Clause]
funClauses=[Clause]
cs}) -> do
          [Clause]
cs' <- (Clause -> TCMT IO Clause) -> [Clause] -> TCMT IO [Clause]
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 Clause -> TCMT IO Clause
reconsClause [Clause]
cs
          TCMT IO Term -> TCMT IO Term
forall (m :: * -> *) a. MonadTCEnv m => m a -> m a
locallyReconstructed (TCMT IO Term -> TCMT IO Term) -> TCMT IO Term -> TCMT IO Term
forall a b. (a -> b) -> a -> b
$ Definition -> TCMT IO Term
quoteDefn Definition
ci{theDef :: Defn
theDef=Defn
f{funClauses :: [Clause]
funClauses=[Clause]
cs'}}

        Defn
_ -> Definition -> TCMT IO Term
quoteDefn Definition
ci

      where
        reconsClause :: Clause -> TCM Clause
        reconsClause :: Clause -> TCMT IO Clause
reconsClause Clause
c = do
          Tele (Dom Type)
tel' <- Tele (Dom Type) -> TCM (Tele (Dom Type))
reconsTel (Tele (Dom Type) -> TCM (Tele (Dom Type)))
-> Tele (Dom Type) -> TCM (Tele (Dom Type))
forall a b. (a -> b) -> a -> b
$ Clause -> Tele (Dom Type)
clauseTel Clause
c
          Maybe Term
b' <- case (Clause -> Maybe (Arg Type)
clauseType Clause
c, Clause -> Maybe Term
clauseBody Clause
c) of
                (Just Arg Type
t, Just Term
b) ->
                  Tele (Dom Type) -> TCMT IO (Maybe Term) -> TCMT IO (Maybe Term)
forall b (m :: * -> *) a.
(AddContext b, MonadAddContext m) =>
b -> m a -> m a
forall (m :: * -> *) a.
MonadAddContext m =>
Tele (Dom Type) -> m a -> m a
addContext (Clause -> Tele (Dom Type)
clauseTel Clause
c) (TCMT IO (Maybe Term) -> TCMT IO (Maybe Term))
-> TCMT IO (Maybe Term) -> TCMT IO (Maybe Term)
forall a b. (a -> b) -> a -> b
$ do
                     Term
bb <- TCMT IO Term -> TCMT IO Term
forall (m :: * -> *) a. MonadTCEnv m => m a -> m a
locallyReduceAllDefs
                           (TCMT IO Term -> TCMT IO Term) -> TCMT IO Term -> TCMT IO Term
forall a b. (a -> b) -> a -> b
$ Action (TCMT IO) -> Type -> Term -> TCMT IO Term
reconstructParameters' Action (TCMT IO)
forall (m :: * -> *). PureTCM m => Action m
defaultAction (Arg Type -> Type
forall e. Arg e -> e
unArg Arg Type
t) Term
b
                     Maybe Term -> TCMT IO (Maybe Term)
forall a. a -> TCMT IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Term -> TCMT IO (Maybe Term))
-> Maybe Term -> TCMT IO (Maybe Term)
forall a b. (a -> b) -> a -> b
$ Term -> Maybe Term
forall a. a -> Maybe a
Just Term
bb
                (Maybe (Arg Type), Maybe Term)
_ -> Maybe Term -> TCMT IO (Maybe Term)
forall a. a -> TCMT IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Term -> TCMT IO (Maybe Term))
-> Maybe Term -> TCMT IO (Maybe Term)
forall a b. (a -> b) -> a -> b
$ Clause -> Maybe Term
clauseBody Clause
c
          let c' :: Clause
c' = Clause
c{clauseBody :: Maybe Term
clauseBody=Maybe Term
b', clauseTel :: Tele (Dom Type)
clauseTel=Tele (Dom Type)
tel'}
          [Char] -> Int -> TCMT IO Doc -> TCMT IO ()
forall (m :: * -> *).
MonadDebug m =>
[Char] -> Int -> TCMT IO Doc -> m ()
reportSDoc [Char]
"tc.reconstruct" Int
50
                   (TCMT IO Doc -> TCMT IO ()) -> TCMT IO Doc -> TCMT IO ()
forall a b. (a -> b) -> a -> b
$ TCMT IO Doc
"getDefinition reconstructed clause:" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> Clause -> TCMT IO Doc
forall (m :: * -> *) a. (Applicative m, Pretty a) => a -> m Doc
pretty Clause
c'
          Clause -> TCMT IO Clause
forall a. a -> TCMT IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Clause
c'

        reconsTel :: Telescope -> TCM Telescope
        reconsTel :: Tele (Dom Type) -> TCM (Tele (Dom Type))
reconsTel Tele (Dom Type)
EmptyTel = Tele (Dom Type) -> TCM (Tele (Dom Type))
forall a. a -> TCMT IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Tele (Dom Type)
forall a. Tele a
EmptyTel
        reconsTel (ExtendTel Dom Type
_ NoAbs{}) = TCM (Tele (Dom Type))
forall a. HasCallStack => a
__IMPOSSIBLE__
        reconsTel (ExtendTel (d :: Dom Type
d@Dom{unDom :: forall t e. Dom' t e -> e
unDom=Type
t}) ds :: Abs (Tele (Dom Type))
ds@Abs{unAbs :: forall a. Abs a -> a
unAbs=Tele (Dom Type)
ts}) = do
           Type
t <- TCM Type -> TCM Type
forall (m :: * -> *) a. MonadTCEnv m => m a -> m a
locallyReduceAllDefs (TCM Type -> TCM Type) -> TCM Type -> TCM Type
forall a b. (a -> b) -> a -> b
$ Type -> TCM Type
reconstructParametersInType Type
t
           let d' :: Dom Type
d' = Dom Type
d{unDom :: Type
unDom=Type
t}
           Tele (Dom Type)
ts' <- Dom Type -> TCM (Tele (Dom Type)) -> TCM (Tele (Dom Type))
forall b (m :: * -> *) a.
(AddContext b, MonadAddContext m) =>
b -> m a -> m a
forall (m :: * -> *) a. MonadAddContext m => Dom Type -> m a -> m a
addContext Dom Type
d' (TCM (Tele (Dom Type)) -> TCM (Tele (Dom Type)))
-> TCM (Tele (Dom Type)) -> TCM (Tele (Dom Type))
forall a b. (a -> b) -> a -> b
$ Tele (Dom Type) -> TCM (Tele (Dom Type))
reconsTel Tele (Dom Type)
ts
           Tele (Dom Type) -> TCM (Tele (Dom Type))
forall a. a -> TCMT IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Tele (Dom Type) -> TCM (Tele (Dom Type)))
-> Tele (Dom Type) -> TCM (Tele (Dom Type))
forall a b. (a -> b) -> a -> b
$ Dom Type -> Abs (Tele (Dom Type)) -> Tele (Dom Type)
forall a. a -> Abs (Tele a) -> Tele a
ExtendTel Dom Type
d' Abs (Tele (Dom Type))
ds{unAbs :: Tele (Dom Type)
unAbs=Tele (Dom Type)
ts'}


    setDirty :: UnquoteM ()
    setDirty :: ReaderT
  Context
  (StateT
     UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
  ()
setDirty = (UnquoteState -> UnquoteState)
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((Dirty -> Dirty) -> UnquoteState -> UnquoteState
forall b c d. (b -> c) -> (b, d) -> (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first ((Dirty -> Dirty) -> UnquoteState -> UnquoteState)
-> (Dirty -> Dirty) -> UnquoteState -> UnquoteState
forall a b. (a -> b) -> a -> b
$ Dirty -> Dirty -> Dirty
forall a b. a -> b -> a
const Dirty
Dirty)

    tcDeclareDef :: Arg QName -> R.Type -> UnquoteM Term
    tcDeclareDef :: Arg QName
-> Type
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
tcDeclareDef (Arg ArgInfo
i QName
x) Type
a = ReaderT
  Context
  (StateT
     UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
  Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
forall a. UnquoteM a -> UnquoteM a
inOriginalContext (ReaderT
   Context
   (StateT
      UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
   Term
 -> ReaderT
      Context
      (StateT
         UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
      Term)
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
forall a b. (a -> b) -> a -> b
$ do
      ReaderT
  Context
  (StateT
     UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
  ()
setDirty
      Bool
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     ()
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ArgInfo -> Bool
forall a. LensHiding a => a -> Bool
hidden ArgInfo
i) (ReaderT
   Context
   (StateT
      UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
   ()
 -> ReaderT
      Context
      (StateT
         UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
      ())
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     ()
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     ()
forall a b. (a -> b) -> a -> b
$ TCMT IO ()
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     ()
forall a.
TCM a
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     a
forall (tcm :: * -> *) a. MonadTCM tcm => TCM a -> tcm a
liftTCM (TCMT IO ()
 -> ReaderT
      Context
      (StateT
         UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
      ())
-> TCMT IO ()
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     ()
forall a b. (a -> b) -> a -> b
$ TypeError -> TCMT IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadTCError m) =>
TypeError -> m a
typeError (TypeError -> TCMT IO ())
-> (Doc -> TypeError) -> Doc -> TCMT IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> TypeError
GenericDocError (Doc -> TCMT IO ()) -> TCMT IO Doc -> TCMT IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
        TCMT IO Doc
"Cannot declare hidden function" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> QName -> TCMT IO Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
forall (m :: * -> *). MonadPretty m => QName -> m Doc
prettyTCM QName
x
      [QName]
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [QName
x]
      TCMT IO Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
forall a.
TCM a
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     a
forall (tcm :: * -> *) a. MonadTCM tcm => TCM a -> tcm a
liftTCM (TCMT IO Term
 -> ReaderT
      Context
      (StateT
         UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
      Term)
-> TCMT IO Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
forall a b. (a -> b) -> a -> b
$ do
        [Char] -> Int -> TCMT IO Doc -> TCMT IO ()
forall (m :: * -> *).
MonadDebug m =>
[Char] -> Int -> TCMT IO Doc -> m ()
reportSDoc [Char]
"tc.unquote.decl" Int
10 (TCMT IO Doc -> TCMT IO ()) -> TCMT IO Doc -> TCMT IO ()
forall a b. (a -> b) -> a -> b
$ [TCMT IO Doc] -> TCMT IO Doc
forall (m :: * -> *) (t :: * -> *).
(Applicative m, Foldable t) =>
t (m Doc) -> m Doc
sep
          [ TCMT IO Doc
"declare" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> QName -> TCMT IO Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
forall (m :: * -> *). MonadPretty m => QName -> m Doc
prettyTCM QName
x TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> TCMT IO Doc
":"
          , Int -> TCMT IO Doc -> TCMT IO Doc
forall (m :: * -> *). Functor m => Int -> m Doc -> m Doc
nest Int
2 (TCMT IO Doc -> TCMT IO Doc) -> TCMT IO Doc -> TCMT IO Doc
forall a b. (a -> b) -> a -> b
$ Type -> TCMT IO Doc
forall r (m :: * -> *).
(ToAbstract r, PrettyTCM (AbsOfRef r), MonadPretty m,
 MonadError TCErr m) =>
r -> m Doc
prettyR Type
a
          ]
        Type
a <- TCM Type -> TCM Type
forall (m :: * -> *) a. MonadTCEnv m => m a -> m a
locallyReduceAllDefs (TCM Type -> TCM Type) -> TCM Type -> TCM Type
forall a b. (a -> b) -> a -> b
$ Expr -> TCM Type
isType_ (Expr -> TCM Type) -> TCM Expr -> TCM Type
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Type -> TCMT IO (AbsOfRef Type)
forall r (m :: * -> *).
(ToAbstract r, MonadFresh NameId m, MonadError TCErr m,
 MonadTCEnv m, ReadTCState m, HasOptions m, HasBuiltins m,
 HasConstInfo m) =>
r -> m (AbsOfRef r)
toAbstract_ Type
a
        Bool
alreadyDefined <- Either SigError Definition -> Bool
forall a b. Either a b -> Bool
isRight (Either SigError Definition -> Bool)
-> TCMT IO (Either SigError Definition) -> TCMT IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> QName -> TCMT IO (Either SigError Definition)
forall (m :: * -> *).
HasConstInfo m =>
QName -> m (Either SigError Definition)
getConstInfo' QName
x
        Bool -> TCMT IO () -> TCMT IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
alreadyDefined (TCMT IO () -> TCMT IO ()) -> TCMT IO () -> TCMT IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> TCMT IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadTCError m) =>
[Char] -> m a
genericError ([Char] -> TCMT IO ()) -> [Char] -> TCMT IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Multiple declarations of " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ QName -> [Char]
forall a. Pretty a => a -> [Char]
prettyShow QName
x
        QName -> ArgInfo -> QName -> Type -> Defn -> TCMT IO ()
addConstant' QName
x ArgInfo
i QName
x Type
a Defn
emptyFunction
        Bool -> TCMT IO () -> TCMT IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ArgInfo -> Bool
forall a. LensHiding a => a -> Bool
isInstance ArgInfo
i) (TCMT IO () -> TCMT IO ()) -> TCMT IO () -> TCMT IO ()
forall a b. (a -> b) -> a -> b
$ QName -> Type -> TCMT IO ()
addTypedInstance QName
x Type
a
        TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primUnitUnit

    tcDeclarePostulate :: Arg QName -> R.Type -> UnquoteM Term
    tcDeclarePostulate :: Arg QName
-> Type
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
tcDeclarePostulate (Arg ArgInfo
i QName
x) Type
a = ReaderT
  Context
  (StateT
     UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
  Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
forall a. UnquoteM a -> UnquoteM a
inOriginalContext (ReaderT
   Context
   (StateT
      UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
   Term
 -> ReaderT
      Context
      (StateT
         UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
      Term)
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
forall a b. (a -> b) -> a -> b
$ do
      CommandLineOptions
clo <- ReaderT
  Context
  (StateT
     UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
  CommandLineOptions
forall (m :: * -> *). HasOptions m => m CommandLineOptions
commandLineOptions
      Bool
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     ()
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CommandLineOptions -> Bool
forall a. LensSafeMode a => a -> Bool
Lens.getSafeMode CommandLineOptions
clo) (ReaderT
   Context
   (StateT
      UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
   ()
 -> ReaderT
      Context
      (StateT
         UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
      ())
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     ()
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     ()
forall a b. (a -> b) -> a -> b
$ TCMT IO ()
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     ()
forall a.
TCM a
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     a
forall (tcm :: * -> *) a. MonadTCM tcm => TCM a -> tcm a
liftTCM (TCMT IO ()
 -> ReaderT
      Context
      (StateT
         UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
      ())
-> TCMT IO ()
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     ()
forall a b. (a -> b) -> a -> b
$ TypeError -> TCMT IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadTCError m) =>
TypeError -> m a
typeError (TypeError -> TCMT IO ())
-> (Doc -> TypeError) -> Doc -> TCMT IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> TypeError
GenericDocError (Doc -> TCMT IO ()) -> TCMT IO Doc -> TCMT IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
        TCMT IO Doc
"Cannot postulate '" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> QName -> TCMT IO Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
forall (m :: * -> *). MonadPretty m => QName -> m Doc
prettyTCM QName
x 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 -> TCMT IO Doc -> TCMT IO Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> Type -> TCMT IO Doc
forall r (m :: * -> *).
(ToAbstract r, PrettyTCM (AbsOfRef r), MonadPretty m,
 MonadError TCErr m) =>
r -> m Doc
prettyR Type
a TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> TCMT IO Doc
"' with safe flag"
      ReaderT
  Context
  (StateT
     UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
  ()
setDirty
      Bool
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     ()
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ArgInfo -> Bool
forall a. LensHiding a => a -> Bool
hidden ArgInfo
i) (ReaderT
   Context
   (StateT
      UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
   ()
 -> ReaderT
      Context
      (StateT
         UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
      ())
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     ()
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     ()
forall a b. (a -> b) -> a -> b
$ TCMT IO ()
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     ()
forall a.
TCM a
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     a
forall (tcm :: * -> *) a. MonadTCM tcm => TCM a -> tcm a
liftTCM (TCMT IO ()
 -> ReaderT
      Context
      (StateT
         UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
      ())
-> TCMT IO ()
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     ()
forall a b. (a -> b) -> a -> b
$ TypeError -> TCMT IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadTCError m) =>
TypeError -> m a
typeError (TypeError -> TCMT IO ())
-> (Doc -> TypeError) -> Doc -> TCMT IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> TypeError
GenericDocError (Doc -> TCMT IO ()) -> TCMT IO Doc -> TCMT IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
        TCMT IO Doc
"Cannot declare hidden function" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> QName -> TCMT IO Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
forall (m :: * -> *). MonadPretty m => QName -> m Doc
prettyTCM QName
x
      [QName]
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [QName
x]
      TCMT IO Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
forall a.
TCM a
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     a
forall (tcm :: * -> *) a. MonadTCM tcm => TCM a -> tcm a
liftTCM (TCMT IO Term
 -> ReaderT
      Context
      (StateT
         UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
      Term)
-> TCMT IO Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
forall a b. (a -> b) -> a -> b
$ do
        [Char] -> Int -> TCMT IO Doc -> TCMT IO ()
forall (m :: * -> *).
MonadDebug m =>
[Char] -> Int -> TCMT IO Doc -> m ()
reportSDoc [Char]
"tc.unquote.decl" Int
10 (TCMT IO Doc -> TCMT IO ()) -> TCMT IO Doc -> TCMT IO ()
forall a b. (a -> b) -> a -> b
$ [TCMT IO Doc] -> TCMT IO Doc
forall (m :: * -> *) (t :: * -> *).
(Applicative m, Foldable t) =>
t (m Doc) -> m Doc
sep
          [ TCMT IO Doc
"declare Postulate" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> QName -> TCMT IO Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
forall (m :: * -> *). MonadPretty m => QName -> m Doc
prettyTCM QName
x TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> TCMT IO Doc
":"
          , Int -> TCMT IO Doc -> TCMT IO Doc
forall (m :: * -> *). Functor m => Int -> m Doc -> m Doc
nest Int
2 (TCMT IO Doc -> TCMT IO Doc) -> TCMT IO Doc -> TCMT IO Doc
forall a b. (a -> b) -> a -> b
$ Type -> TCMT IO Doc
forall r (m :: * -> *).
(ToAbstract r, PrettyTCM (AbsOfRef r), MonadPretty m,
 MonadError TCErr m) =>
r -> m Doc
prettyR Type
a
          ]
        Type
a <- TCM Type -> TCM Type
forall (m :: * -> *) a. MonadTCEnv m => m a -> m a
locallyReduceAllDefs (TCM Type -> TCM Type) -> TCM Type -> TCM Type
forall a b. (a -> b) -> a -> b
$ Expr -> TCM Type
isType_ (Expr -> TCM Type) -> TCM Expr -> TCM Type
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Type -> TCMT IO (AbsOfRef Type)
forall r (m :: * -> *).
(ToAbstract r, MonadFresh NameId m, MonadError TCErr m,
 MonadTCEnv m, ReadTCState m, HasOptions m, HasBuiltins m,
 HasConstInfo m) =>
r -> m (AbsOfRef r)
toAbstract_ Type
a
        Bool
alreadyDefined <- Either SigError Definition -> Bool
forall a b. Either a b -> Bool
isRight (Either SigError Definition -> Bool)
-> TCMT IO (Either SigError Definition) -> TCMT IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> QName -> TCMT IO (Either SigError Definition)
forall (m :: * -> *).
HasConstInfo m =>
QName -> m (Either SigError Definition)
getConstInfo' QName
x
        Bool -> TCMT IO () -> TCMT IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
alreadyDefined (TCMT IO () -> TCMT IO ()) -> TCMT IO () -> TCMT IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> TCMT IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadTCError m) =>
[Char] -> m a
genericError ([Char] -> TCMT IO ()) -> [Char] -> TCMT IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Multiple declarations of " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ QName -> [Char]
forall a. Pretty a => a -> [Char]
prettyShow QName
x
        QName -> ArgInfo -> QName -> Type -> Defn -> TCMT IO ()
addConstant' QName
x ArgInfo
i QName
x Type
a Defn
defaultAxiom
        Bool -> TCMT IO () -> TCMT IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ArgInfo -> Bool
forall a. LensHiding a => a -> Bool
isInstance ArgInfo
i) (TCMT IO () -> TCMT IO ()) -> TCMT IO () -> TCMT IO ()
forall a b. (a -> b) -> a -> b
$ QName -> Type -> TCMT IO ()
addTypedInstance QName
x Type
a
        TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primUnitUnit

    -- A datatype is expected to be declared with a function type.
    -- The second argument indicates how many preceding types are parameters.
    tcDeclareData :: QName -> Integer -> R.Type -> UnquoteM Term
    tcDeclareData :: QName
-> Integer
-> Type
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
tcDeclareData QName
x Integer
npars Type
t = ReaderT
  Context
  (StateT
     UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
  Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
forall a. UnquoteM a -> UnquoteM a
inOriginalContext (ReaderT
   Context
   (StateT
      UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
   Term
 -> ReaderT
      Context
      (StateT
         UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
      Term)
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
forall a b. (a -> b) -> a -> b
$ do
      ReaderT
  Context
  (StateT
     UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
  ()
setDirty
      [QName]
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [QName
x]
      TCMT IO Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
forall a.
TCM a
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     a
forall (tcm :: * -> *) a. MonadTCM tcm => TCM a -> tcm a
liftTCM (TCMT IO Term
 -> ReaderT
      Context
      (StateT
         UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
      Term)
-> TCMT IO Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
forall a b. (a -> b) -> a -> b
$ do
        [Char] -> Int -> TCMT IO Doc -> TCMT IO ()
forall (m :: * -> *).
MonadDebug m =>
[Char] -> Int -> TCMT IO Doc -> m ()
reportSDoc [Char]
"tc.unquote.decl" Int
10 (TCMT IO Doc -> TCMT IO ()) -> TCMT IO Doc -> TCMT IO ()
forall a b. (a -> b) -> a -> b
$ [TCMT IO Doc] -> TCMT IO Doc
forall (m :: * -> *) (t :: * -> *).
(Applicative m, Foldable t) =>
t (m Doc) -> m Doc
sep
          [ TCMT IO Doc
"declare Data" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> QName -> TCMT IO Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
forall (m :: * -> *). MonadPretty m => QName -> m Doc
prettyTCM QName
x TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> TCMT IO Doc
":"
          , Int -> TCMT IO Doc -> TCMT IO Doc
forall (m :: * -> *). Functor m => Int -> m Doc -> m Doc
nest Int
2 (TCMT IO Doc -> TCMT IO Doc) -> TCMT IO Doc -> TCMT IO Doc
forall a b. (a -> b) -> a -> b
$ Type -> TCMT IO Doc
forall r (m :: * -> *).
(ToAbstract r, PrettyTCM (AbsOfRef r), MonadPretty m,
 MonadError TCErr m) =>
r -> m Doc
prettyR Type
t
          ]
        Bool
alreadyDefined <- Either SigError Definition -> Bool
forall a b. Either a b -> Bool
isRight (Either SigError Definition -> Bool)
-> TCMT IO (Either SigError Definition) -> TCMT IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> QName -> TCMT IO (Either SigError Definition)
forall (m :: * -> *).
HasConstInfo m =>
QName -> m (Either SigError Definition)
getConstInfo' QName
x
        Bool -> TCMT IO () -> TCMT IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
alreadyDefined (TCMT IO () -> TCMT IO ()) -> TCMT IO () -> TCMT IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> TCMT IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadTCError m) =>
[Char] -> m a
genericError ([Char] -> TCMT IO ()) -> [Char] -> TCMT IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Multiple declarations of " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ QName -> [Char]
forall a. Pretty a => a -> [Char]
prettyShow QName
x
        Expr
e <- Type -> TCMT IO (AbsOfRef Type)
forall r (m :: * -> *).
(ToAbstract r, MonadFresh NameId m, MonadError TCErr m,
 MonadTCEnv m, ReadTCState m, HasOptions m, HasBuiltins m,
 HasConstInfo m) =>
r -> m (AbsOfRef r)
toAbstract_ Type
t
        -- The type to be checked with @checkSig@ is without parameters.
        let ([TypedBinding]
tel, Expr
e') = Int -> Expr -> ([TypedBinding], Expr)
splitPars (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
npars) Expr
e
        IsAbstract
ac <- (TCEnv -> IsAbstract) -> TCMT IO IsAbstract
forall (m :: * -> *) a. MonadTCEnv m => (TCEnv -> a) -> m a
asksTC (TCEnv -> Lens' IsAbstract TCEnv -> IsAbstract
forall o i. o -> Lens' i o -> i
^. (IsAbstract -> f IsAbstract) -> TCEnv -> f TCEnv
forall a. LensIsAbstract a => Lens' IsAbstract a
Lens' IsAbstract TCEnv
lensIsAbstract)
        let defIn :: DefInfo' Expr
defIn = Name -> Fixity' -> Access -> IsAbstract -> Range -> DefInfo' Expr
forall t.
Name -> Fixity' -> Access -> IsAbstract -> Range -> DefInfo' t
mkDefInfo (Name -> Name
nameConcrete (Name -> Name) -> Name -> Name
forall a b. (a -> b) -> a -> b
$ QName -> Name
qnameName QName
x) Fixity'
noFixity' Access
PublicAccess IsAbstract
ac Range
forall a. Range' a
noRange
        KindOfName
-> DefInfo' Expr
-> QName
-> GeneralizeTelescope
-> Expr
-> TCMT IO ()
checkSig KindOfName
DataName DefInfo' Expr
defIn QName
x (Map QName Name -> [TypedBinding] -> GeneralizeTelescope
A.GeneralizeTel Map QName Name
forall k a. Map k a
Map.empty [TypedBinding]
tel) Expr
e'
        TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primUnitUnit

    tcDefineData :: QName -> [(QName, R.Type)] -> UnquoteM Term
    tcDefineData :: QName
-> [(QName, Type)]
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
tcDefineData QName
x [(QName, Type)]
cs = ReaderT
  Context
  (StateT
     UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
  Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
forall a. UnquoteM a -> UnquoteM a
inOriginalContext (ReaderT
   Context
   (StateT
      UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
   Term
 -> ReaderT
      Context
      (StateT
         UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
      Term)
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
forall a b. (a -> b) -> a -> b
$ (ReaderT
  Context
  (StateT
     UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
  ()
setDirty ReaderT
  Context
  (StateT
     UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
  ()
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
forall a b.
ReaderT
  Context
  (StateT
     UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
  a
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     b
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>) (ReaderT
   Context
   (StateT
      UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
   Term
 -> ReaderT
      Context
      (StateT
         UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
      Term)
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
forall a b. (a -> b) -> a -> b
$ TCMT IO Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
forall a.
TCM a
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     a
forall (tcm :: * -> *) a. MonadTCM tcm => TCM a -> tcm a
liftTCM (TCMT IO Term
 -> ReaderT
      Context
      (StateT
         UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
      Term)
-> TCMT IO Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
forall a b. (a -> b) -> a -> b
$ do
      TCMT IO (Either SigError Definition)
-> (SigError -> TCMT IO Term)
-> (Definition -> TCMT IO Term)
-> TCMT IO Term
forall (m :: * -> *) a b c.
Monad m =>
m (Either a b) -> (a -> m c) -> (b -> m c) -> m c
caseEitherM (QName -> TCMT IO (Either SigError Definition)
forall (m :: * -> *).
HasConstInfo m =>
QName -> m (Either SigError Definition)
getConstInfo' QName
x)
        (TCMT IO Term -> SigError -> TCMT IO Term
forall a b. a -> b -> a
const (TCMT IO Term -> SigError -> TCMT IO Term)
-> TCMT IO Term -> SigError -> TCMT IO Term
forall a b. (a -> b) -> a -> b
$ [Char] -> TCMT IO Term
forall (m :: * -> *) a.
(HasCallStack, MonadTCError m) =>
[Char] -> m a
genericError ([Char] -> TCMT IO Term) -> [Char] -> TCMT IO Term
forall a b. (a -> b) -> a -> b
$ [Char]
"Missing declaration for " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ QName -> [Char]
forall a. Pretty a => a -> [Char]
prettyShow QName
x) ((Definition -> TCMT IO Term) -> TCMT IO Term)
-> (Definition -> TCMT IO Term) -> TCMT IO Term
forall a b. (a -> b) -> a -> b
$ \Definition
def -> do
        Int
npars <- case Definition -> Defn
theDef Definition
def of
                   DataOrRecSig Int
n -> Int -> TCMT IO Int
forall a. a -> TCMT IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
n
                   Defn
_              -> [Char] -> TCMT IO Int
forall (m :: * -> *) a.
(HasCallStack, MonadTCError m) =>
[Char] -> m a
genericError ([Char] -> TCMT IO Int) -> [Char] -> TCMT IO Int
forall a b. (a -> b) -> a -> b
$ QName -> [Char]
forall a. Pretty a => a -> [Char]
prettyShow QName
x [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
                     [Char]
" is not declared as a datatype or record, or it already has a definition."

        -- For some reasons, reifying parameters and adding them to the context via
        -- `addContext` before `toAbstract_` is different from substituting the type after
        -- `toAbstract_, so some dummy parameters are added and removed later.
        [Expr]
es <- ((QName, Type) -> TCM Expr) -> [(QName, Type)] -> TCMT IO [Expr]
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 (Type -> TCM Expr
Type -> TCMT IO (AbsOfRef Type)
forall r (m :: * -> *).
(ToAbstract r, MonadFresh NameId m, MonadError TCErr m,
 MonadTCEnv m, ReadTCState m, HasOptions m, HasBuiltins m,
 HasConstInfo m) =>
r -> m (AbsOfRef r)
toAbstract_ (Type -> TCM Expr)
-> ((QName, Type) -> Type) -> (QName, Type) -> TCM Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Type -> Type
addDummy Int
npars (Type -> Type) -> ((QName, Type) -> Type) -> (QName, Type) -> Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (QName, Type) -> Type
forall a b. (a, b) -> b
snd) [(QName, Type)]
cs
        [Char] -> Int -> TCMT IO Doc -> TCMT IO ()
forall (m :: * -> *).
MonadDebug m =>
[Char] -> Int -> TCMT IO Doc -> m ()
reportSDoc [Char]
"tc.unquote.def" Int
10 (TCMT IO Doc -> TCMT IO ()) -> TCMT IO Doc -> TCMT IO ()
forall a b. (a -> b) -> a -> b
$ [TCMT IO Doc] -> TCMT IO Doc
forall (m :: * -> *) (t :: * -> *).
(Applicative m, Foldable t) =>
t (m Doc) -> m Doc
vcat ([TCMT IO Doc] -> TCMT IO Doc) -> [TCMT IO Doc] -> TCMT IO Doc
forall a b. (a -> b) -> a -> b
$
          [ TCMT IO Doc
"declaring constructors of" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> QName -> TCMT IO Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
forall (m :: * -> *). MonadPretty m => QName -> m Doc
prettyTCM QName
x 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] -> [TCMT IO Doc] -> [TCMT IO Doc]
forall a. [a] -> [a] -> [a]
++ (Expr -> TCMT IO Doc) -> [Expr] -> [TCMT IO Doc]
forall a b. (a -> b) -> [a] -> [b]
map Expr -> TCMT IO Doc
forall a (m :: * -> *).
(ToConcrete a, Pretty (ConOfAbs a), MonadAbsToCon m) =>
a -> m Doc
prettyA [Expr]
es

        -- Translate parameters from internal definitions back to abstract syntax.
        Type
t   <- Type -> TCM Type
forall a (m :: * -> *).
(InstantiateFull a, MonadReduce m) =>
a -> m a
instantiateFull (Type -> TCM Type)
-> (Definition -> Type) -> Definition -> TCM Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Definition -> Type
defType (Definition -> TCM Type) -> TCM Definition -> TCM Type
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Definition -> TCM Definition
forall (m :: * -> *).
(Functor m, HasConstInfo m, HasOptions m, ReadTCState m,
 MonadTCEnv m, MonadDebug m) =>
Definition -> m Definition
instantiateDef Definition
def
        [TypedBinding]
tel <- Tele (Dom Type) -> TCMT IO [TypedBinding]
Tele (Dom Type) -> TCMT IO (ReifiesTo (Tele (Dom Type)))
forall i (m :: * -> *).
(Reify i, MonadReify m) =>
i -> m (ReifiesTo i)
forall (m :: * -> *).
MonadReify m =>
Tele (Dom Type) -> m (ReifiesTo (Tele (Dom Type)))
reify (Tele (Dom Type) -> TCMT IO [TypedBinding])
-> TCM (Tele (Dom Type)) -> TCMT IO [TypedBinding]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< TelV Type -> Tele (Dom Type)
forall a. TelV a -> Tele (Dom a)
theTel (TelV Type -> Tele (Dom Type))
-> TCMT IO (TelV Type) -> TCM (Tele (Dom Type))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Type -> TCMT IO (TelV Type)
forall (m :: * -> *).
(MonadReduce m, MonadAddContext m) =>
Int -> Type -> m (TelV Type)
telViewUpTo Int
npars Type
t

        [Expr]
es' <- case (Expr -> Maybe Expr) -> [Expr] -> Maybe [Expr]
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 (([TypedBinding] -> Expr -> Maybe Expr)
-> ([TypedBinding], Expr) -> Maybe Expr
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ([TypedBinding] -> [TypedBinding] -> Expr -> Maybe Expr
substNames' [TypedBinding]
tel) (([TypedBinding], Expr) -> Maybe Expr)
-> (Expr -> ([TypedBinding], Expr)) -> Expr -> Maybe Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Expr -> ([TypedBinding], Expr)
splitPars Int
npars) [Expr]
es of
                 Maybe [Expr]
Nothing -> [Char] -> TCMT IO [Expr]
forall (m :: * -> *) a.
(HasCallStack, MonadTCError m) =>
[Char] -> m a
genericError ([Char] -> TCMT IO [Expr]) -> [Char] -> TCMT IO [Expr]
forall a b. (a -> b) -> a -> b
$ [Char]
"Number of parameters doesn't match!"
                 Just [Expr]
es -> [Expr] -> TCMT IO [Expr]
forall a. a -> TCMT IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [Expr]
es

        IsAbstract
ac <- (TCEnv -> IsAbstract) -> TCMT IO IsAbstract
forall (m :: * -> *) a. MonadTCEnv m => (TCEnv -> a) -> m a
asksTC (TCEnv -> Lens' IsAbstract TCEnv -> IsAbstract
forall o i. o -> Lens' i o -> i
^. (IsAbstract -> f IsAbstract) -> TCEnv -> f TCEnv
forall a. LensIsAbstract a => Lens' IsAbstract a
Lens' IsAbstract TCEnv
lensIsAbstract)
        let i :: DefInfo' Expr
i = Name -> Fixity' -> Access -> IsAbstract -> Range -> DefInfo' Expr
forall t.
Name -> Fixity' -> Access -> IsAbstract -> Range -> DefInfo' t
mkDefInfo (Name -> Name
nameConcrete (Name -> Name) -> Name -> Name
forall a b. (a -> b) -> a -> b
$ QName -> Name
qnameName QName
x) Fixity'
noFixity' Access
PublicAccess IsAbstract
ac Range
forall a. Range' a
noRange
            conNames :: [QName]
conNames = ((QName, Type) -> QName) -> [(QName, Type)] -> [QName]
forall a b. (a -> b) -> [a] -> [b]
map (QName, Type) -> QName
forall a b. (a, b) -> a
fst [(QName, Type)]
cs
            toAxiom :: QName -> Expr -> Declaration
toAxiom QName
c Expr
e = KindOfName
-> DefInfo' Expr
-> ArgInfo
-> Maybe [Occurrence]
-> QName
-> Expr
-> Declaration
A.Axiom KindOfName
ConName DefInfo' Expr
i ArgInfo
defaultArgInfo Maybe [Occurrence]
forall a. Maybe a
Nothing QName
c Expr
e
            as :: [Declaration]
as = (QName -> Expr -> Declaration)
-> [QName] -> [Expr] -> [Declaration]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith QName -> Expr -> Declaration
toAxiom [QName]
conNames [Expr]
es'
            lams :: [LamBinding]
lams = (TypedBinding -> LamBinding) -> [TypedBinding] -> [LamBinding]
forall a b. (a -> b) -> [a] -> [b]
map (\case {A.TBind Range
_ TypedBindingInfo
tac (NamedArg Binder
b :| []) Expr
_ -> Maybe Expr -> NamedArg Binder -> LamBinding
A.DomainFree (TypedBindingInfo -> Maybe Expr
tbTacticAttr TypedBindingInfo
tac) NamedArg Binder
b
                              ;TypedBinding
_ -> LamBinding
forall a. HasCallStack => a
__IMPOSSIBLE__ }) [TypedBinding]
tel
        [Char] -> Int -> TCMT IO Doc -> TCMT IO ()
forall (m :: * -> *).
MonadDebug m =>
[Char] -> Int -> TCMT IO Doc -> m ()
reportSDoc [Char]
"tc.unquote.def" Int
10 (TCMT IO Doc -> TCMT IO ()) -> TCMT IO Doc -> TCMT IO ()
forall a b. (a -> b) -> a -> b
$ [TCMT IO Doc] -> TCMT IO Doc
forall (m :: * -> *) (t :: * -> *).
(Applicative m, Foldable t) =>
t (m Doc) -> m Doc
vcat ([TCMT IO Doc] -> TCMT IO Doc) -> [TCMT IO Doc] -> TCMT IO Doc
forall a b. (a -> b) -> a -> b
$
          [ TCMT IO Doc
"checking datatype: " TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> QName -> TCMT IO Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
forall (m :: * -> *). MonadPretty m => QName -> m Doc
prettyTCM QName
x TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> TCMT IO Doc
" with constructors:"
          , Int -> TCMT IO Doc -> TCMT IO Doc
forall (m :: * -> *). Functor m => Int -> m Doc -> m Doc
nest Int
2 ([TCMT IO Doc] -> TCMT IO Doc
forall (m :: * -> *) (t :: * -> *).
(Applicative m, Foldable t) =>
t (m Doc) -> m Doc
vcat ((QName -> TCMT IO Doc) -> [QName] -> [TCMT IO Doc]
forall a b. (a -> b) -> [a] -> [b]
map QName -> TCMT IO Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
forall (m :: * -> *). MonadPretty m => QName -> m Doc
prettyTCM [QName]
conNames))
          ]
        DefInfo' Expr
-> QName
-> UniverseCheck
-> DataDefParams
-> [Declaration]
-> TCMT IO ()
checkDataDef DefInfo' Expr
i QName
x UniverseCheck
YesUniverseCheck (Set Name -> [LamBinding] -> DataDefParams
A.DataDefParams Set Name
forall a. Set a
Set.empty [LamBinding]
lams) [Declaration]
as
        TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primUnitUnit
      where
        addDummy :: Int -> R.Type -> R.Type
        addDummy :: Int -> Type -> Type
addDummy Int
0 Type
t = Type
t
        addDummy Int
n Type
t = Dom Type -> Abs Type -> Type
R.Pi (Type -> Dom Type
forall a. a -> Dom a
defaultDom (Sort -> Type
R.Sort (Sort -> Type) -> Sort -> Type
forall a b. (a -> b) -> a -> b
$ Integer -> Sort
R.LitS Integer
0)) ([Char] -> Type -> Abs Type
forall a. [Char] -> a -> Abs a
R.Abs [Char]
"dummy" (Type -> Abs Type) -> Type -> Abs Type
forall a b. (a -> b) -> a -> b
$ Int -> Type -> Type
addDummy (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Type
t)

        substNames' :: [A.TypedBinding] -> [A.TypedBinding] -> A.Expr -> Maybe A.Expr
        substNames' :: [TypedBinding] -> [TypedBinding] -> Expr -> Maybe Expr
substNames' (TypedBinding
a : [TypedBinding]
as) (TypedBinding
b : [TypedBinding]
bs) Expr
e = do
          let (A.TBind Range
_ TypedBindingInfo
_ (NamedArg Binder
na :| [NamedArg Binder]
_) Expr
expra) = TypedBinding
a
              (A.TBind Range
_ TypedBindingInfo
_ (NamedArg Binder
nb :| [NamedArg Binder]
_) Expr
exprb) = TypedBinding
b
              getName :: NamedArg Binder -> Name
getName NamedArg Binder
n = BindName -> Name
A.unBind (BindName -> Name) -> (Binder -> BindName) -> Binder -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Binder -> BindName
forall a. Binder' a -> a
A.binderName (Binder -> Name) -> Binder -> Name
forall a b. (a -> b) -> a -> b
$ NamedArg Binder -> Binder
forall a. NamedArg a -> a
namedArg NamedArg Binder
n
          Expr
e' <- [TypedBinding] -> [TypedBinding] -> Expr -> Maybe Expr
substNames' [TypedBinding]
as [TypedBinding]
bs Expr
e
          Expr -> Maybe Expr
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr -> Maybe Expr) -> Expr -> Maybe Expr
forall a b. (a -> b) -> a -> b
$ (Expr -> Expr) -> Expr -> Expr
forall a. ExprLike a => (Expr -> Expr) -> a -> a
mapExpr (Name -> Name -> Expr -> Expr
substName (NamedArg Binder -> Name
getName NamedArg Binder
na) (NamedArg Binder -> Name
getName NamedArg Binder
nb)) Expr
e'
          where
            -- Substitute @Var x@ for @Var y@ in an @Expr@.
            substName :: Name -> Name -> (A.Expr -> A.Expr)
            substName :: Name -> Name -> Expr -> Expr
substName Name
x Name
y e :: Expr
e@(A.Var Name
n)
                    | Name
y Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
n    = Name -> Expr
A.Var Name
x
                    | Bool
otherwise = Expr
e
            substName Name
_ Name
_ Expr
e = Expr
e
        substNames' [] [] Expr
e = Expr -> Maybe Expr
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return Expr
e
        substNames' [TypedBinding]
_ [TypedBinding]
_ Expr
_ = Maybe Expr
forall a. Maybe a
Nothing

    tcDefineFun :: QName -> [R.Clause] -> UnquoteM Term
    tcDefineFun :: QName
-> [Clause]
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
tcDefineFun QName
x [Clause]
cs = ReaderT
  Context
  (StateT
     UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
  Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
forall a. UnquoteM a -> UnquoteM a
inOriginalContext (ReaderT
   Context
   (StateT
      UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
   Term
 -> ReaderT
      Context
      (StateT
         UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
      Term)
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
forall a b. (a -> b) -> a -> b
$ (ReaderT
  Context
  (StateT
     UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
  ()
setDirty ReaderT
  Context
  (StateT
     UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
  ()
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
forall a b.
ReaderT
  Context
  (StateT
     UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
  a
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     b
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>) (ReaderT
   Context
   (StateT
      UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
   Term
 -> ReaderT
      Context
      (StateT
         UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
      Term)
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
forall a b. (a -> b) -> a -> b
$ TCMT IO Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
forall a.
TCM a
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     a
forall (tcm :: * -> *) a. MonadTCM tcm => TCM a -> tcm a
liftTCM (TCMT IO Term
 -> ReaderT
      Context
      (StateT
         UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
      Term)
-> TCMT IO Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
forall a b. (a -> b) -> a -> b
$ do
      TCMT IO Bool -> TCMT IO () -> TCMT IO ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM (Either SigError Definition -> Bool
forall a b. Either a b -> Bool
isLeft (Either SigError Definition -> Bool)
-> TCMT IO (Either SigError Definition) -> TCMT IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> QName -> TCMT IO (Either SigError Definition)
forall (m :: * -> *).
HasConstInfo m =>
QName -> m (Either SigError Definition)
getConstInfo' QName
x) (TCMT IO () -> TCMT IO ()) -> TCMT IO () -> TCMT IO ()
forall a b. (a -> b) -> a -> b
$
        [Char] -> TCMT IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadTCError m) =>
[Char] -> m a
genericError ([Char] -> TCMT IO ()) -> [Char] -> TCMT IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Missing declaration for " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ QName -> [Char]
forall a. Pretty a => a -> [Char]
prettyShow QName
x
      [Clause]
cs <- (Clause -> TCMT IO Clause) -> [Clause] -> TCMT IO [Clause]
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 (QNamed Clause -> TCMT IO Clause
QNamed Clause -> TCMT IO (AbsOfRef (QNamed Clause))
forall r (m :: * -> *).
(ToAbstract r, MonadFresh NameId m, MonadError TCErr m,
 MonadTCEnv m, ReadTCState m, HasOptions m, HasBuiltins m,
 HasConstInfo m) =>
r -> m (AbsOfRef r)
toAbstract_ (QNamed Clause -> TCMT IO Clause)
-> (Clause -> QNamed Clause) -> Clause -> TCMT IO Clause
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QName -> Clause -> QNamed Clause
forall a. QName -> a -> QNamed a
QNamed QName
x) [Clause]
cs
      [Char] -> Int -> TCMT IO Doc -> TCMT IO ()
forall (m :: * -> *).
MonadDebug m =>
[Char] -> Int -> TCMT IO Doc -> m ()
reportSDoc [Char]
"tc.unquote.def" Int
10 (TCMT IO Doc -> TCMT IO ()) -> TCMT IO Doc -> TCMT IO ()
forall a b. (a -> b) -> a -> b
$ [TCMT IO Doc] -> TCMT IO Doc
forall (m :: * -> *) (t :: * -> *).
(Applicative m, Foldable t) =>
t (m Doc) -> m Doc
vcat ([TCMT IO Doc] -> TCMT IO Doc) -> [TCMT IO Doc] -> TCMT IO Doc
forall a b. (a -> b) -> a -> b
$ (Clause -> TCMT IO Doc) -> [Clause] -> [TCMT IO Doc]
forall a b. (a -> b) -> [a] -> [b]
map Clause -> TCMT IO Doc
forall a (m :: * -> *).
(ToConcrete a, Pretty (ConOfAbs a), MonadAbsToCon m) =>
a -> m Doc
prettyA [Clause]
cs
      let accessDontCare :: a
accessDontCare = a
forall a. HasCallStack => a
__IMPOSSIBLE__  -- or ConcreteDef, value not looked at
      IsAbstract
ac <- (TCEnv -> IsAbstract) -> TCMT IO IsAbstract
forall (m :: * -> *) a. MonadTCEnv m => (TCEnv -> a) -> m a
asksTC (TCEnv -> Lens' IsAbstract TCEnv -> IsAbstract
forall o i. o -> Lens' i o -> i
^. (IsAbstract -> f IsAbstract) -> TCEnv -> f TCEnv
forall a. LensIsAbstract a => Lens' IsAbstract a
Lens' IsAbstract TCEnv
lensIsAbstract)     -- Issue #4012, respect AbstractMode
      let i :: DefInfo' Expr
i = Name -> Fixity' -> Access -> IsAbstract -> Range -> DefInfo' Expr
forall t.
Name -> Fixity' -> Access -> IsAbstract -> Range -> DefInfo' t
mkDefInfo (Name -> Name
nameConcrete (Name -> Name) -> Name -> Name
forall a b. (a -> b) -> a -> b
$ QName -> Name
qnameName QName
x) Fixity'
noFixity' Access
forall {a}. a
accessDontCare IsAbstract
ac Range
forall a. Range' a
noRange
      TCMT IO () -> TCMT IO ()
forall (m :: * -> *) a. MonadTCEnv m => m a -> m a
locallyReduceAllDefs (TCMT IO () -> TCMT IO ()) -> TCMT IO () -> TCMT IO ()
forall a b. (a -> b) -> a -> b
$ Delayed -> DefInfo' Expr -> QName -> [Clause] -> TCMT IO ()
checkFunDef Delayed
NotDelayed DefInfo' Expr
i QName
x [Clause]
cs
      TCMT IO Term
forall (m :: * -> *).
(HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
m Term
primUnitUnit

    tcRunSpeculative :: Term -> UnquoteM Term
    tcRunSpeculative :: Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
tcRunSpeculative Term
mu = do
      TCState
oldState <- ReaderT
  Context
  (StateT
     UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
  TCState
forall (m :: * -> *). MonadTCState m => m TCState
getTC
      Term
u <- Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
forall a (m :: * -> *). (Reduce a, MonadReduce m) => a -> m a
reduce (Term
 -> ReaderT
      Context
      (StateT
         UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
      Term)
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
evalTCM Term
mu
      case Term
u of
        Con ConHead
_ ConInfo
_ [Apply (Arg { unArg :: forall e. Arg e -> e
unArg = Term
x }), Apply (Arg { unArg :: forall e. Arg e -> e
unArg = Term
b })] -> do
          UnquoteM Bool
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     ()
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
unlessM (Term -> UnquoteM Bool
forall a. Unquote a => Term -> UnquoteM a
unquote Term
b) (ReaderT
   Context
   (StateT
      UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
   ()
 -> ReaderT
      Context
      (StateT
         UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
      ())
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     ()
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     ()
forall a b. (a -> b) -> a -> b
$ TCState
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     ()
forall (m :: * -> *). MonadTCState m => TCState -> m ()
putTC TCState
oldState
          Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
forall a.
a
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     a
forall (m :: * -> *) a. Monad m => a -> m a
return Term
x
        Term
_ -> TCMT IO Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
forall a.
TCM a
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     a
forall (tcm :: * -> *) a. MonadTCM tcm => TCM a -> tcm a
liftTCM (TCMT IO Term
 -> ReaderT
      Context
      (StateT
         UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
      Term)
-> TCMT IO Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
forall a b. (a -> b) -> a -> b
$ TypeError -> TCMT IO Term
forall (m :: * -> *) a.
(HasCallStack, MonadTCError m) =>
TypeError -> m a
typeError (TypeError -> TCMT IO Term)
-> (Doc -> TypeError) -> Doc -> TCMT IO Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> TypeError
GenericDocError (Doc -> TCMT IO Term) -> TCMT IO Doc -> TCMT IO Term
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
          TCMT IO Doc
"Should be a pair: " TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> Term -> TCMT IO Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
forall (m :: * -> *). MonadPretty m => Term -> m Doc
prettyTCM Term
u

    tcGetInstances :: MetaId -> UnquoteM Term
    tcGetInstances :: MetaId
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
tcGetInstances MetaId
m = TCM (Either Blocker [Candidate])
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     (Either Blocker [Candidate])
forall a.
TCM a
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     a
forall (tcm :: * -> *) a. MonadTCM tcm => TCM a -> tcm a
liftTCM (MetaId -> TCM (Either Blocker [Candidate])
getInstanceCandidates MetaId
m) ReaderT
  Context
  (StateT
     UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
  (Either Blocker [Candidate])
-> (Either Blocker [Candidate]
    -> ReaderT
         Context
         (StateT
            UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
         Term)
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
forall a b.
ReaderT
  Context
  (StateT
     UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
  a
-> (a
    -> ReaderT
         Context
         (StateT
            UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
         b)
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Left Blocker
unblock -> do
        TCState
s <- (UnquoteState -> TCState)
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     TCState
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets UnquoteState -> TCState
forall a b. (a, b) -> b
snd
        UnquoteError
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
forall a.
UnquoteError
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (TCState -> Blocker -> UnquoteError
BlockedOnMeta TCState
s Blocker
unblock)
      Right [Candidate]
cands -> TCMT IO Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
forall a.
TCM a
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     a
forall (tcm :: * -> *) a. MonadTCM tcm => TCM a -> tcm a
liftTCM (TCMT IO Term
 -> ReaderT
      Context
      (StateT
         UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
      Term)
-> TCMT IO Term
-> ReaderT
     Context
     (StateT
        UnquoteState (WriterT [QName] (ExceptT UnquoteError (TCMT IO))))
     Term
forall a b. (a -> b) -> a -> b
$
        TCM ([Term] -> Term)
buildList TCM ([Term] -> Term) -> TCMT IO [Term] -> TCMT IO Term
forall a b. TCMT IO (a -> b) -> TCMT IO a -> TCMT IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Candidate -> TCMT IO Term) -> [Candidate] -> TCMT IO [Term]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Term -> TCMT IO Term
quoteTerm (Term -> TCMT IO Term)
-> (Candidate -> Term) -> Candidate -> TCMT IO Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Candidate -> Term
candidateTerm) [Candidate]
cands

    splitPars :: Int -> A.Expr -> ([A.TypedBinding], A.Expr)
    splitPars :: Int -> Expr -> ([TypedBinding], Expr)
splitPars Int
0 Expr
e = ([] , Expr
e)
    splitPars Int
npars (A.Pi ExprInfo
_ (TypedBinding
n :| [TypedBinding]
_) Expr
e) = ([TypedBinding] -> [TypedBinding])
-> ([TypedBinding], Expr) -> ([TypedBinding], Expr)
forall b c d. (b -> c) -> (b, d) -> (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (TypedBinding
n TypedBinding -> [TypedBinding] -> [TypedBinding]
forall a. a -> [a] -> [a]
:) (Int -> Expr -> ([TypedBinding], Expr)
splitPars (Int
npars Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Expr
e)
    splitPars Int
npars Expr
e = ([TypedBinding], Expr)
forall a. HasCallStack => a
__IMPOSSIBLE__
------------------------------------------------------------------------
-- * Trusted executables
------------------------------------------------------------------------

type ExeArg  = Text
type StdIn   = Text
type StdOut  = Text
type StdErr  = Text

-- | Raise an error if the @--allow-exec@ option was not specified.
--
requireAllowExec :: TCM ()
requireAllowExec :: TCMT IO ()
requireAllowExec = do
  Bool
allowExec <- PragmaOptions -> Bool
optAllowExec (PragmaOptions -> Bool) -> TCMT IO PragmaOptions -> TCMT IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TCMT IO PragmaOptions
forall (m :: * -> *). HasOptions m => m PragmaOptions
pragmaOptions
  Bool -> TCMT IO () -> TCMT IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
allowExec (TCMT IO () -> TCMT IO ()) -> TCMT IO () -> TCMT IO ()
forall a b. (a -> b) -> a -> b
$
    TypeError -> TCMT IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadTCError m) =>
TypeError -> m a
typeError (TypeError -> TCMT IO ()) -> TypeError -> TCMT IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> TypeError
GenericError [Char]
"Missing option --allow-exec"

-- | Convert an @ExitCode@ to an Agda natural number.
--
exitCodeToNat :: ExitCode -> Nat
exitCodeToNat :: ExitCode -> Nat
exitCodeToNat  ExitCode
ExitSuccess    = Integer -> Nat
Nat Integer
0
exitCodeToNat (ExitFailure Int
n) = Integer -> Nat
Nat (Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
n)

-- | Call a trusted executable with the given arguments and input.
--
--   Returns the exit code, stdout, and stderr.
--
tcExec :: ExeName -> [ExeArg] -> StdIn -> TCM Term
tcExec :: ExeName -> [ExeName] -> ExeName -> TCMT IO Term
tcExec ExeName
exe [ExeName]
args ExeName
stdIn = do
  TCMT IO ()
requireAllowExec
  Map ExeName [Char]
exes <- CommandLineOptions -> Map ExeName [Char]
optTrustedExecutables (CommandLineOptions -> Map ExeName [Char])
-> TCMT IO CommandLineOptions -> TCMT IO (Map ExeName [Char])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TCMT IO CommandLineOptions
forall (m :: * -> *). HasOptions m => m CommandLineOptions
commandLineOptions
  case ExeName -> Map ExeName [Char] -> Maybe [Char]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ExeName
exe Map ExeName [Char]
exes of
    Maybe [Char]
Nothing -> ExeName -> Map ExeName [Char] -> TCMT IO Term
forall a. ExeName -> Map ExeName [Char] -> TCM a
raiseExeNotTrusted ExeName
exe Map ExeName [Char]
exes
    Just [Char]
fp -> do
      -- Check that the executable exists.
      TCMT IO Bool -> TCMT IO () -> TCMT IO ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
unlessM (IO Bool -> TCMT IO Bool
forall a. IO a -> TCMT IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> TCMT IO Bool) -> IO Bool -> TCMT IO Bool
forall a b. (a -> b) -> a -> b
$ [Char] -> IO Bool
doesFileExist [Char]
fp) (TCMT IO () -> TCMT IO ()) -> TCMT IO () -> TCMT IO ()
forall a b. (a -> b) -> a -> b
$ ExeName -> [Char] -> TCMT IO ()
forall a. ExeName -> [Char] -> TCM a
raiseExeNotFound ExeName
exe [Char]
fp
      -- Check that the executable is executable.
      TCMT IO Bool -> TCMT IO () -> TCMT IO ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
unlessM (IO Bool -> TCMT IO Bool
forall a. IO a -> TCMT IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> TCMT IO Bool) -> IO Bool -> TCMT IO Bool
forall a b. (a -> b) -> a -> b
$ Permissions -> Bool
executable (Permissions -> Bool) -> IO Permissions -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> IO Permissions
getPermissions [Char]
fp) (TCMT IO () -> TCMT IO ()) -> TCMT IO () -> TCMT IO ()
forall a b. (a -> b) -> a -> b
$ ExeName -> [Char] -> TCMT IO ()
forall a. ExeName -> [Char] -> TCM a
raiseExeNotExecutable ExeName
exe [Char]
fp

      let strArgs :: [[Char]]
strArgs    = ExeName -> [Char]
T.unpack (ExeName -> [Char]) -> [ExeName] -> [[Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ExeName]
args
      let strStdIn :: [Char]
strStdIn   = ExeName -> [Char]
T.unpack ExeName
stdIn
      (ExitCode
datExitCode, [Char]
strStdOut, [Char]
strStdErr) <- IO (ExitCode, [Char], [Char]) -> TCMT IO (ExitCode, [Char], [Char])
forall (m :: * -> *) a. Monad m => m a -> TCMT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO (ExitCode, [Char], [Char])
 -> TCMT IO (ExitCode, [Char], [Char]))
-> IO (ExitCode, [Char], [Char])
-> TCMT IO (ExitCode, [Char], [Char])
forall a b. (a -> b) -> a -> b
$ [Char] -> [[Char]] -> [Char] -> IO (ExitCode, [Char], [Char])
readProcessWithExitCode [Char]
fp [[Char]]
strArgs [Char]
strStdIn
      let natExitCode :: Nat
natExitCode = ExitCode -> Nat
exitCodeToNat ExitCode
datExitCode
      let txtStdOut :: ExeName
txtStdOut   = [Char] -> ExeName
T.pack [Char]
strStdOut
      let txtStdErr :: ExeName
txtStdErr   = [Char] -> ExeName
T.pack [Char]
strStdErr
      (Nat, (ExeName, ExeName)) -> Term
toR <- TCM ((Nat, (ExeName, ExeName)) -> Term)
forall a. ToTerm a => TCM (a -> Term)
toTerm
      Term -> TCMT IO Term
forall a. a -> TCMT IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Term -> TCMT IO Term) -> Term -> TCMT IO Term
forall a b. (a -> b) -> a -> b
$ (Nat, (ExeName, ExeName)) -> Term
toR (Nat
natExitCode, (ExeName
txtStdOut, ExeName
txtStdErr))

-- | Raise an error if the trusted executable cannot be found.
--
raiseExeNotTrusted :: ExeName -> Map ExeName FilePath -> TCM a
raiseExeNotTrusted :: forall a. ExeName -> Map ExeName [Char] -> TCM a
raiseExeNotTrusted ExeName
exe Map ExeName [Char]
exes = Doc -> TCMT IO a
forall (m :: * -> *) a.
(HasCallStack, MonadTCError m) =>
Doc -> m a
genericDocError (Doc -> TCMT IO a) -> TCMT IO Doc -> TCMT IO a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< do
  [TCMT IO Doc] -> TCMT IO Doc
forall (m :: * -> *) (t :: * -> *).
(Applicative m, Foldable t) =>
t (m Doc) -> m Doc
vcat ([TCMT IO Doc] -> TCMT IO Doc)
-> ([[Char]] -> [TCMT IO Doc]) -> [[Char]] -> TCMT IO Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char] -> TCMT IO Doc) -> [[Char]] -> [TCMT IO Doc]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> TCMT IO Doc
forall (m :: * -> *) a. (Applicative m, Pretty a) => a -> m Doc
pretty ([[Char]] -> TCMT IO Doc) -> [[Char]] -> TCMT IO Doc
forall a b. (a -> b) -> a -> b
$
    ([Char]
"Could not find '" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ ExeName -> [Char]
T.unpack ExeName
exe [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"' in list of trusted executables:") [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
:
    [ [Char]
"  - " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ ExeName -> [Char]
T.unpack ExeName
exe | ExeName
exe <- Map ExeName [Char] -> [ExeName]
forall k a. Map k a -> [k]
Map.keys Map ExeName [Char]
exes ]

raiseExeNotFound :: ExeName -> FilePath -> TCM a
raiseExeNotFound :: forall a. ExeName -> [Char] -> TCM a
raiseExeNotFound ExeName
exe [Char]
fp = Doc -> TCMT IO a
forall (m :: * -> *) a.
(HasCallStack, MonadTCError m) =>
Doc -> m a
genericDocError (Doc -> TCMT IO a) -> TCMT IO Doc -> TCMT IO a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< do
  [Char] -> TCMT IO Doc
forall (m :: * -> *). Applicative m => [Char] -> m Doc
text ([Char] -> TCMT IO Doc) -> [Char] -> TCMT IO Doc
forall a b. (a -> b) -> a -> b
$ [Char]
"Could not find file '" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
fp [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"' for trusted executable " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ ExeName -> [Char]
T.unpack ExeName
exe

raiseExeNotExecutable :: ExeName -> FilePath -> TCM a
raiseExeNotExecutable :: forall a. ExeName -> [Char] -> TCM a
raiseExeNotExecutable ExeName
exe [Char]
fp = Doc -> TCMT IO a
forall (m :: * -> *) a.
(HasCallStack, MonadTCError m) =>
Doc -> m a
genericDocError (Doc -> TCMT IO a) -> TCMT IO Doc -> TCMT IO a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< do
  [Char] -> TCMT IO Doc
forall (m :: * -> *). Applicative m => [Char] -> m Doc
text ([Char] -> TCMT IO Doc) -> [Char] -> TCMT IO Doc
forall a b. (a -> b) -> a -> b
$ [Char]
"File '" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
fp [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"' for trusted executable" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ ExeName -> [Char]
T.unpack ExeName
exe [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" does not have permission to execute"