rn4MtoTcM,
- TcError(..), TcWarning(..), Message(..),
+ TcError(..), TcWarning(..),
mkTcErr, arityErr,
-- For closure
MutableVar(..), _MutableArray
) where
+import Ubiq{-uitous-}
import TcMLoop ( TcEnv, initEnv, TcMaybe ) -- We need the type TcEnv and an initial Env
import Type ( Type(..), GenType )
import TyVar ( TyVar(..), GenTyVar )
import Usage ( Usage(..), GenUsage )
+import ErrUtils ( Error(..), Message(..), ErrCtxt(..),
+ Warning(..) )
import SST
-import RnMonad4
-import RnUtils ( GlobalNameMappers(..), GlobalNameMapper(..) )
+--import RnMonad4
+--LATER:import RnUtils ( GlobalNameMappers(..), GlobalNameMapper(..) )
import Bag ( Bag, emptyBag, isEmptyBag,
foldBag, unitBag, unionBags, snocBag )
import Outputable ( Outputable(..), NamedThing(..), ExportFlag )
import ErrUtils ( Error(..) )
import Maybes ( MaybeErr(..) )
-import Name ( Name )
-import ProtoName ( ProtoName )
+--import Name ( Name )
import SrcLoc ( SrcLoc, mkUnknownSrcLoc )
import UniqFM ( UniqFM, emptyUFM )
import UniqSupply ( UniqSupply, getUnique, getUniques, splitUniqSupply )
initTc :: UniqSupply
-> TcM _RealWorld r
- -> MaybeErr (r, Bag TcWarning)
- (Bag TcError, Bag TcWarning)
+ -> MaybeErr (r, Bag Warning)
+ (Bag Error, Bag Warning)
initTc us do_this
= _runSST (
belong to the main thread. We throw away any error messages!
\begin{pseudocode}
-forkNF_Tc :: NF_TcM s r -> NF_TcM s r
-forkNF_Tc m down env
- = forkTcDown down `thenSST` \ down' ->
- returnSST (_runSST (m down' (forkTcEnv env)))
+forkNF_Tc :: NF_TcM s' r -> NF_TcM s r
+forkNF_Tc m (TcDown deflts u_var src_loc err_cxt err_var) env
+ = -- Get a fresh unique supply
+ readMutVarSST u_var `thenSST` \ us ->
+ let
+ (us1, us2) = splitUniqSupply us
+ in
+ writeMutVarSST u_var us1 `thenSST_`
+ returnSST (_runSST (
+ newMutVarSST us2 `thenSST` \ u_var' ->
+ newMutVarSST (emptyBag,emptyBag) `thenSST` \ err_var' ->
+ newMutVarSST emptyUFM `thenSST` \ tv_var' ->
+ let
+ down' = TcDown deflts us_var src_loc err_cxt err_var'
+ env' = forkEnv env tv_var'
+ in
+ m down' env'
+
+ -- ToDo: optionally dump any error messages
+ ))
+\end{pseudocode}
+
+@forkTcDown@ makes a new "down" blob for a lazily-computed fork
+of the type checker.
+
+\begin{pseudocode}
+forkTcDown (TcDown deflts u_var src_loc err_cxt err_var)
+ = -- Get a fresh unique supply
+ readMutVarSST u_var `thenSST` \ us ->
+ let
+ (us1, us2) = splitUniqSupply us
+ in
+ writeMutVarSST u_var us1 `thenSST_`
+
+ -- Make fresh MutVars for the unique supply and errors
+ newMutVarSST us2 `thenSST` \ u_var' ->
+ newMutVarSST (emptyBag, emptyBag) `thenSST` \ err_var' ->
+
+ -- Done
+ returnSST (TcDown deflts u_var' src_loc err_cxt err_var')
\end{pseudocode}
SrcLoc -- Source location
(ErrCtxt s) -- Error context
- (MutableVar s (Bag TcWarning,
- Bag TcError))
+ (MutableVar s (Bag Warning,
+ Bag Error))
type ErrCtxt s = [NF_TcM s Message] -- Innermost first. Monadic so that we have a chance
-- to deal with bound type variables just before error
getErrCtxt (TcDown def us loc ctxt errs) = ctxt
\end{code}
-@forkTcDown@ makes a new "down" blob for a lazily-computed fork
-of the type checker.
-
-\begin{code}
-forkTcDown (TcDown deflts u_var src_loc err_cxt err_var)
- = -- Get a fresh unique supply
- readMutVarSST u_var `thenSST` \ us ->
- let
- (us1, us2) = splitUniqSupply us
- in
- writeMutVarSST u_var us1 `thenSST_`
-
- -- Make fresh MutVars for the unique supply and errors
- newMutVarSST us2 `thenSST` \ u_var' ->
- newMutVarSST (emptyBag, emptyBag) `thenSST` \ err_var' ->
-
- -- Done
- returnSST (TcDown deflts u_var' src_loc err_cxt err_var')
-\end{code}
-
\section{rn4MtoTcM}
%~~~~~~~~~~~~~~~~~~
\begin{code}
+rn4MtoTcM = panic "TcMonad.rn4MtoTcM (ToDo LATER)"
+{- LATER:
rn4MtoTcM :: GlobalNameMappers -> Rn4M a -> NF_TcM s (a, Bag Error)
rn4MtoTcM name_funs rn_action down env
returnSST (rn_result, rn_errs)
where
u_var = getUniqSupplyVar down
+-}
\end{code}
~~~~~~~~~~~~~~~~~~~
\begin{code}
-type Message = PprStyle -> Pretty
type TcError = Message
type TcWarning = Message
-
mkTcErr :: SrcLoc -- Where
-> [Message] -- Context
-> Message -- What went wrong