Commit 16530a4a authored by sewardj's avatar sewardj
Browse files

[project @ 2000-10-16 14:28:54 by sewardj]

More typechecker bits.
parent 5083c7ed
......@@ -54,7 +54,7 @@ import DataCon ( DataCon )
import TyCon ( TyCon, tyConKind, tyConArity, isSynTyCon )
import Class ( Class, ClassOpItem, ClassContext, classTyCon )
import Subst ( substTy )
import Name ( Name, OccName, Provenance(..), ExportFlag(..), NamedThing(..),
import Name ( Name, OccName, NamedThing(..),
nameOccName, nameModule, getSrcLoc, mkGlobalName,
isLocallyDefined,
NameEnv, emptyNameEnv, lookupNameEnv, nameEnvElts,
......@@ -64,7 +64,7 @@ import OccName ( mkDFunOcc, mkDefaultMethodOcc, occNameString )
import Module ( Module )
import Unify ( unifyTyListsX, matchTys )
import HscTypes ( ModDetails(..), InstEnv, lookupTypeEnv, TyThing(..),
GlobalSymbolTable )
GlobalSymbolTable, Provenance(..) )
import Unique ( pprUnique10, Unique, Uniquable(..) )
import UniqFM
import Unique ( Uniquable(..) )
......
......@@ -59,7 +59,8 @@ import Name ( Name )
import Var ( Id, TyVar, newMutTyVar, newSigTyVar, readMutTyVar, writeMutTyVar )
import VarEnv ( TidyEnv, emptyTidyEnv )
import VarSet ( TyVarSet )
import UniqSupply ( UniqSupply, uniqFromSupply, uniqsFromSupply, splitUniqSupply,
import UniqSupply ( UniqSupply, uniqFromSupply, uniqsFromSupply,
splitUniqSupply, mkSplitUniqSupply,
UniqSM, initUs_ )
import SrcLoc ( SrcLoc, noSrcLoc )
import FiniteMap ( FiniteMap, lookupFM, addToFM, emptyFM )
......@@ -124,24 +125,14 @@ type TcRef a = IORef a
\end{code}
\begin{code}
<<<<<<< TcMonad.lhs
-- initEnv is passed in to avoid module recursion between TcEnv & TcMonad.
initTc :: DynFlags
-> UniqSupply
-> (TcRef (UniqFM a) -> TcEnv)
=======
initTc :: TcEnv
initTc :: DynFlags
-> TcEnv
-> SrcLoc
>>>>>>> 1.44
-> TcM r
-> IO (Maybe r, (Bag ErrMsg, Bag WarnMsg))
<<<<<<< TcMonad.lhs
initTc dflags us initenv do_this
=======
initTc tc_env src_loc do_this
>>>>>>> 1.44
initTc dflags tc_env src_loc do_this
= do {
us <- mkSplitUniqSupply 'a' ;
us_var <- newIORef us ;
......@@ -150,17 +141,12 @@ initTc tc_env src_loc do_this
tvs_var <- newIORef emptyUFM ;
let
<<<<<<< TcMonad.lhs
init_down = TcDown dflags [] us_var dfun_var
noSrcLoc
=======
init_down = TcDown [] us_var dfun_var
src_loc
>>>>>>> 1.44
[] errs_var
;
maybe_res <- catch (do { res <- do_this init_down env ;
maybe_res <- catch (do { res <- do_this init_down tc_env ;
return (Just res)})
(\_ -> return Nothing) ;
......@@ -321,7 +307,7 @@ addErrTc err_msg = addErrTcM (emptyTidyEnv, err_msg)
addErrsTc :: [Message] -> NF_TcM ()
addErrsTc [] = returnNF_Tc ()
addErrsTc err_msgs = listNF_Tc_ (map addErrTc err_msgs) `thenNF_Tc_` returnNF_Tc ()
addErrsTc err_msgs = listNF_Tc (map addErrTc err_msgs) `thenNF_Tc_` returnNF_Tc ()
-- The 'M' variants do the TidyEnv bit
failWithTcM :: (TidyEnv, Message) -> TcM a -- Add an error message and fail
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment