<commit_before>%
% (c) The GRASP Project, Glasgow University, 1992-2002
%
\begin{code}
module TcRnTypes(
	TcRn, TcM, RnM,	-- The monad is opaque outside this module

	-- Standard monadic operations
	thenM, thenM_, returnM, failM,

	-- Non-standard operations
	runTcRn, fixM, tryM, ioToTcRn,
	newMutVar, readMutVar, writeMutVar,
	getEnv, setEnv, updEnv, unsafeInterleaveM, zapEnv,
		
	-- The environment types
	Env(..), TopEnv(..), TcGblEnv(..), 
	TcLclEnv(..), RnLclEnv(..),

	-- Ranamer types
	RnMode(..), isInterfaceMode, isCmdLineMode,
	EntityUsage, emptyUsages, ErrCtxt,
	ImportAvails(..), emptyImportAvails, plusImportAvails, 
	plusAvail, pruneAvails,  
	AvailEnv, emptyAvailEnv, unitAvailEnv, plusAvailEnv, 
	mkAvailEnv, lookupAvailEnv, lookupAvailEnv_maybe, availEnvElts, addAvail,
	WhereFrom(..),

	-- Typechecker types
	TcTyThing(..),

	-- Template Haskell
	Stage(..), topStage, topSpliceStage,
	Level, impLevel, topLevel,

	-- Insts
	Inst(..), InstOrigin(..), InstLoc(..), pprInstLoc, instLocSrcLoc,
	LIE, emptyLIE, unitLIE, plusLIE, consLIE, 
	plusLIEs, mkLIE, isEmptyLIE, lieToList, listToLIE,

	-- Misc other types
	TcRef, TcId, TcIdSet
  ) where

#include "HsVersions.h"

import HsSyn		( PendingSplice, HsOverLit, MonoBinds, RuleDecl, ForeignDecl )
import RnHsSyn		( RenamedHsExpr, RenamedPat, RenamedArithSeqInfo )
import HscTypes		( GhciMode, ExternalPackageState, HomePackageTable, 
			  NameCache, GlobalRdrEnv, LocalRdrEnv, FixityEnv,
			  TypeEnv, TyThing, Avails, GenAvailInfo(..), AvailInfo,
			   availName, IsBootInterface, Deprecations,
			   ExternalPackageState(..), emptyExternalPackageState )
import Packages		( PackageName )
import TcType		( TcTyVarSet, TcType, TcTauType, TcThetaType, 
			  TcPredType, TcKind, tcCmpPred, tcCmpType, tcCmpTypes )
import InstEnv		( DFunId, InstEnv )
import Name		( Name )
import NameEnv
import NameSet		( NameSet, emptyNameSet )
import Type		( Type )
import Class		( Class )
import Var		( Id, TyVar )
import VarEnv		( TidyEnv )
import Module
import SrcLoc		( SrcLoc )
import VarSet		( IdSet )
import ErrUtils		( Messages, Message )
import CmdLineOpts	( DynFlags )
import UniqSupply	( UniqSupply )
import BasicTypes	( IPName )
import Util		( thenCmp )
import Bag
import Outputable
import DATA_IOREF	( IORef, newIORef, readIORef, writeIORef )
import UNSAFE_IO	( unsafeInterleaveIO )
import FIX_IO		( fixIO )
import EXCEPTION	( Exception(..) )
import IO		( isUserError )
import Maybe		( mapMaybe )
import ListSetOps	( unionLists )
import Panic		( tryJust )
\end{code}


\begin{code}
type TcRef a = IORef a
type TcId    = Id 			-- Type may be a TcType
type TcIdSet = IdSet
\end{code}

%************************************************************************
%*									*
	       Standard monad definition for TcRn
    All the combinators for the monad can be found in TcRnMonad
%*									*
%************************************************************************

The monad itself has to be defined here, 
because it is mentioned by ErrCtxt

\begin{code}
newtype TcRn m a = TcRn (Env m -> IO a)
unTcRn (TcRn f) = f

type TcM a = TcRn TcLclEnv a
type RnM a = TcRn RnLclEnv a

returnM :: a -> TcRn m a
returnM a = TcRn (\ env -> return a)

thenM :: TcRn m a -> (a -> TcRn m b) -> TcRn m b
thenM (TcRn m) f = TcRn (\ env -> do { r <- m env ;
				       unTcRn (f r) env })

thenM_ :: TcRn m a -> TcRn m b -> TcRn m b
thenM_ (TcRn m) f = TcRn (\ env -> do { m env ; unTcRn f env })

failM :: TcRn m a
failM = TcRn (\ env -> ioError (userError "TcRn failure"))

instance Monad (TcRn m) where
  (>>=)  = thenM
  (>>)   = thenM_
  return = returnM
  fail s = failM	-- Ignore the string
\end{code}


%************************************************************************
%*									*
	Fundmantal combinators specific to the monad
%*									*
%************************************************************************

Running it

\begin{code}
runTcRn :: Env m -> TcRn m a -> IO a
runTcRn env (TcRn m) = m env
\end{code}

The fixpoint combinator

\begin{code}
{-# NOINLINE fixM #-}
  -- Aargh!  Not inlining fixTc alleviates a space leak problem.
  -- Normally fixTc is used with a lazy tuple match: if the optimiser is
  -- shown the definition of fixTc, it occasionally transforms the code
  -- in such a way that the code generator doesn't spot the selector
  -- thunks.  Sigh.

fixM :: (a -> TcRn m a) -> TcRn m a
fixM f = TcRn (\ env -> fixIO (\ r -> unTcRn (f r) env))
\end{code}

Error recovery

\begin{code}
tryM :: TcRn m r -> TcRn m (Either Exception r)
-- Reflect exception into TcRn monad
tryM (TcRn thing) = TcRn (\ env -> tryJust tc_errors (thing env))
  where 
#if __GLASGOW_HASKELL__ > 504 || __GLASGOW_HASKELL__ < 500
	tc_errors e@(IOException ioe) | isUserError ioe = Just e
#else
	tc_errors e | isUserError e = Just e
#endif
	tc_errors _other = Nothing
	-- type checker failures show up as UserErrors only
\end{code}

Lazy interleave <commit_msg>[project @ 2003-05-12 14:12:52 by simonmar] Another bugfix to tryM, this time for GHC 5.00--5.04<commit_after>%
% (c) The GRASP Project, Glasgow University, 1992-2002
%
\begin{code}
module TcRnTypes(
	TcRn, TcM, RnM,	-- The monad is opaque outside this module

	-- Standard monadic operations
	thenM, thenM_, returnM, failM,

	-- Non-standard operations
	runTcRn, fixM, tryM, ioToTcRn,
	newMutVar, readMutVar, writeMutVar,
	getEnv, setEnv, updEnv, unsafeInterleaveM, zapEnv,
		
	-- The environment types
	Env(..), TopEnv(..), TcGblEnv(..), 
	TcLclEnv(..), RnLclEnv(..),

	-- Ranamer types
	RnMode(..), isInterfaceMode, isCmdLineMode,
	EntityUsage, emptyUsages, ErrCtxt,
	ImportAvails(..), emptyImportAvails, plusImportAvails, 
	plusAvail, pruneAvails,  
	AvailEnv, emptyAvailEnv, unitAvailEnv, plusAvailEnv, 
	mkAvailEnv, lookupAvailEnv, lookupAvailEnv_maybe, availEnvElts, addAvail,
	WhereFrom(..),

	-- Typechecker types
	TcTyThing(..),

	-- Template Haskell
	Stage(..), topStage, topSpliceStage,
	Level, impLevel, topLevel,

	-- Insts
	Inst(..), InstOrigin(..), InstLoc(..), pprInstLoc, instLocSrcLoc,
	LIE, emptyLIE, unitLIE, plusLIE, consLIE, 
	plusLIEs, mkLIE, isEmptyLIE, lieToList, listToLIE,

	-- Misc other types
	TcRef, TcId, TcIdSet
  ) where

#include "HsVersions.h"

import HsSyn		( PendingSplice, HsOverLit, MonoBinds, RuleDecl, ForeignDecl )
import RnHsSyn		( RenamedHsExpr, RenamedPat, RenamedArithSeqInfo )
import HscTypes		( GhciMode, ExternalPackageState, HomePackageTable, 
			  NameCache, GlobalRdrEnv, LocalRdrEnv, FixityEnv,
			  TypeEnv, TyThing, Avails, GenAvailInfo(..), AvailInfo,
			   availName, IsBootInterface, Deprecations,
			   ExternalPackageState(..), emptyExternalPackageState )
import Packages		( PackageName )
import TcType		( TcTyVarSet, TcType, TcTauType, TcThetaType, 
			  TcPredType, TcKind, tcCmpPred, tcCmpType, tcCmpTypes )
import InstEnv		( DFunId, InstEnv )
import Name		( Name )
import NameEnv
import NameSet		( NameSet, emptyNameSet )
import Type		( Type )
import Class		( Class )
import Var		( Id, TyVar )
import VarEnv		( TidyEnv )
import Module
import SrcLoc		( SrcLoc )
import VarSet		( IdSet )
import ErrUtils		( Messages, Message )
import CmdLineOpts	( DynFlags )
import UniqSupply	( UniqSupply )
import BasicTypes	( IPName )
import Util		( thenCmp )
import Bag
import Outputable
import DATA_IOREF	( IORef, newIORef, readIORef, writeIORef )
import UNSAFE_IO	( unsafeInterleaveIO )
import FIX_IO		( fixIO )
import EXCEPTION	( Exception(..) )
import IO		( isUserError )
import Maybe		( mapMaybe )
import ListSetOps	( unionLists )
import Panic		( tryJust )
\end{code}


\begin{code}
type TcRef a = IORef a
type TcId    = Id 			-- Type may be a TcType
type TcIdSet = IdSet
\end{code}

%************************************************************************
%*									*
	       Standard monad definition for TcRn
    All the combinators for the monad can be found in TcRnMonad
%*									*
%************************************************************************

The monad itself has to be defined here, 
because it is mentioned by ErrCtxt

\begin{code}
newtype TcRn m a = TcRn (Env m -> IO a)
unTcRn (TcRn f) = f

type TcM a = TcRn TcLclEnv a
type RnM a = TcRn RnLclEnv a

returnM :: a -> TcRn m a
returnM a = TcRn (\ env -> return a)

thenM :: TcRn m a -> (a -> TcRn m b) -> TcRn m b
thenM (TcRn m) f = TcRn (\ env -> do { r <- m env ;
				       unTcRn (f r) env })

thenM_ :: TcRn m a -> TcRn m b -> TcRn m b
thenM_ (TcRn m) f = TcRn (\ env -> do { m env ; unTcRn f env })

failM :: TcRn m a
failM = TcRn (\ env -> ioError (userError "TcRn failure"))

instance Monad (TcRn m) where
  (>>=)  = thenM
  (>>)   = thenM_
  return = returnM
  fail s = failM	-- Ignore the string
\end{code}


%************************************************************************
%*									*
	Fundmantal combinators specific to the monad
%*									*
%************************************************************************

Running it

\begin{code}
runTcRn :: Env m -> TcRn m a -> IO a
runTcRn env (TcRn m) = m env
\end{code}

The fixpoint combinator

\begin{code}
{-# NOINLINE fixM #-}
  -- Aargh!  Not inlining fixTc alleviates a space leak problem.
  -- Normally fixTc is used with a lazy tuple match: if the optimiser is
  -- shown the definition of fixTc, it occasionally transforms the code
  -- in such a way that the code generator doesn't spot the selector
  -- thunks.  Sigh.

fixM :: (a -> TcRn m a) -> TcRn m a
fixM f = TcRn (\ env -> fixIO (\ r -> unTcRn (f r) env))
\end{code}

Error recovery

\begin{code}
tryM :: TcRn m r -> TcRn m (Either Exception r)
-- Reflect exception into TcRn monad
tryM (TcRn thing) = TcRn (\ env -> tryJust tc_errors (thing env))
  where 
#if __GLASGOW_HASKELL__ > 504 || __GLASGOW_HASKELL__ < 500
	tc_errors e@(IOException ioe) | isUserError ioe = Just e
#else
	tc_errors e@(IOException ioe) | isUserError e = Just e
#endif
	tc_errors _other = Nothing
	-- type checker failures show up as UserErrors only
\end{code}

Lazy interleave 
{'fraction_non_alphanumeric': 0.15940862918636226, 'fraction_numerical': 0.004827516846022327, 'mean_word_length': 3.7533460803059273, 'pattern_counts': {'":': 0, '<': 7, '<?xml version=': 0, '>': 51, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '7642332', 'n_tokens_mistral': 3965, 'n_tokens_neox': 3668, 'n_words': 1116}