module Agda.TypeChecking.Monad.Env where
import Control.Monad.Reader
import qualified Data.List as List
import Data.Monoid
import Agda.Syntax.Common
import Agda.Syntax.Abstract.Name
import Agda.TypeChecking.Monad.Base
{-# SPECIALIZE currentModule :: TCM ModuleName #-}
{-# SPECIALIZE currentModule :: ReduceM ModuleName #-}
currentModule :: MonadReader TCEnv m => m ModuleName
currentModule = asks envCurrentModule
withCurrentModule :: ModuleName -> TCM a -> TCM a
withCurrentModule m =
local $ \e -> e { envCurrentModule = m }
{-# SPECIALIZE getAnonymousVariables :: ModuleName -> TCM Nat #-}
{-# SPECIALIZE getAnonymousVariables :: ModuleName -> ReduceM Nat #-}
getAnonymousVariables :: MonadReader TCEnv m => ModuleName -> m Nat
getAnonymousVariables m = do
ms <- asks envAnonymousModules
return $ sum [ n | (m', n) <- ms, mnameToList m' `List.isPrefixOf` mnameToList m ]
withAnonymousModule :: ModuleName -> Nat -> TCM a -> TCM a
withAnonymousModule m n =
local $ \e -> e { envAnonymousModules = (m, n) : envAnonymousModules e
}
withEnv :: TCEnv -> TCM a -> TCM a
withEnv env = local $ \ env0 -> env
{ envAllowDestructiveUpdate = envAllowDestructiveUpdate env0
, envPrintMetasBare = envPrintMetasBare env0
}
getEnv :: TCM TCEnv
getEnv = ask
withIncreasedModuleNestingLevel :: TCM a -> TCM a
withIncreasedModuleNestingLevel =
local (\e -> e { envModuleNestingLevel =
envModuleNestingLevel e + 1 })
withHighlightingLevel :: HighlightingLevel -> TCM a -> TCM a
withHighlightingLevel h = local $ \e -> e { envHighlightingLevel = h }
doExpandLast :: TCM a -> TCM a
doExpandLast = local $ \ e -> e { envExpandLast = ExpandLast }
dontExpandLast :: TCM a -> TCM a
dontExpandLast = local $ \ e -> e { envExpandLast = DontExpandLast }
{-# SPECIALIZE performedSimplification :: TCM a -> TCM a #-}
performedSimplification :: MonadReader TCEnv m => m a -> m a
performedSimplification = local $ \ e -> e { envSimplification = YesSimplification }
{-# SPECIALIZE performedSimplification' :: Simplification -> TCM a -> TCM a #-}
performedSimplification' :: MonadReader TCEnv m => Simplification -> m a -> m a
performedSimplification' simpl = local $ \ e -> e { envSimplification = simpl `mappend` envSimplification e }
getSimplification :: MonadReader TCEnv m => m Simplification
getSimplification = asks envSimplification
updateAllowedReductions :: (AllowedReductions -> AllowedReductions) -> TCEnv -> TCEnv
updateAllowedReductions f e = e { envAllowedReductions = f (envAllowedReductions e) }
modifyAllowedReductions :: (AllowedReductions -> AllowedReductions) -> TCM a -> TCM a
modifyAllowedReductions = local . updateAllowedReductions
putAllowedReductions :: AllowedReductions -> TCM a -> TCM a
putAllowedReductions = modifyAllowedReductions . const
onlyReduceProjections :: TCM a -> TCM a
onlyReduceProjections = putAllowedReductions [ProjectionReductions]
allowAllReductions :: TCM a -> TCM a
allowAllReductions = putAllowedReductions allReductions
allowNonTerminatingReductions :: TCM a -> TCM a
allowNonTerminatingReductions = putAllowedReductions $ [NonTerminatingReductions] ++ allReductions
insideDotPattern :: TCM a -> TCM a
insideDotPattern = local $ \e -> e { envInsideDotPattern = True }
isInsideDotPattern :: TCM Bool
isInsideDotPattern = asks envInsideDotPattern
callByName :: TCM a -> TCM a
callByName = local $ \ e -> e { envCallByNeed = False }