X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;ds=sidebyside;f=ghc%2Fcompiler%2Ftypecheck%2FTcMonad.lhs;h=e595a839e4c1e5c3ef19f23d414737e7e7d149b6;hb=f7ecf7234c224489be8a5e63fced903b655d92ee;hp=8a636e69f5613d663e244eae0f5affe083efacfd;hpb=26741ec416bae2c502ef00a2ba0e79050a32cb67;p=ghc-hetmet.git diff --git a/ghc/compiler/typecheck/TcMonad.lhs b/ghc/compiler/typecheck/TcMonad.lhs index 8a636e6..e595a83 100644 --- a/ghc/compiler/typecheck/TcMonad.lhs +++ b/ghc/compiler/typecheck/TcMonad.lhs @@ -2,7 +2,7 @@ #include "HsVersions.h" module TcMonad( - TcM(..), NF_TcM(..), TcDown, TcEnv, + SYN_IE(TcM), SYN_IE(NF_TcM), TcDown, TcEnv, SST_R, FSST_R, initTc, @@ -28,22 +28,26 @@ module TcMonad( rnMtoTcM, - TcError(..), TcWarning(..), + SYN_IE(TcError), SYN_IE(TcWarning), mkTcErr, arityErr, -- For closure - MutableVar(..), _MutableArray + SYN_IE(MutableVar), +#if __GLASGOW_HASKELL__ >= 200 + GHCbase.MutableArray +#else + _MutableArray +#endif ) where IMP_Ubiq(){-uitous-} -IMPORT_DELOOPER(TcMLoop) ( TcEnv, initEnv, TcMaybe ) -- We need the type TcEnv and an initial Env +IMPORT_DELOOPER(TcMLoop) ( TcEnv, initEnv, TcMaybe ) -- We need the type TcEnv and an initial Env import Type ( SYN_IE(Type), GenType ) import TyVar ( SYN_IE(TyVar), GenTyVar ) import Usage ( SYN_IE(Usage), GenUsage ) -import ErrUtils ( SYN_IE(Error), SYN_IE(Message), ErrCtxt(..), - SYN_IE(Warning) ) +import ErrUtils ( SYN_IE(Error), SYN_IE(Message), SYN_IE(Warning) ) import SST import RnMonad ( SYN_IE(RnM), RnDown, initRn, setExtraRn, @@ -53,9 +57,8 @@ import RnUtils ( SYN_IE(RnEnv) ) import Bag ( Bag, emptyBag, isEmptyBag, foldBag, unitBag, unionBags, snocBag ) -import FiniteMap ( FiniteMap, emptyFM, isEmptyFM, keysFM{-ToDo:rm-} ) +import FiniteMap ( FiniteMap, emptyFM, isEmptyFM{-, keysFM ToDo:rm-} ) --import Outputable ( Outputable(..), NamedThing(..), ExportFlag ) -import ErrUtils ( SYN_IE(Error) ) import Maybes ( MaybeErr(..) ) --import Name ( Name ) import SrcLoc ( SrcLoc, mkUnknownSrcLoc ) @@ -79,11 +82,17 @@ type TcM s r = TcDown s -> TcEnv s -> FSST s r () \end{code} \begin{code} +#if __GLASGOW_HASKELL__ >= 200 +# define REAL_WORLD RealWorld +#else +# define REAL_WORLD _RealWorld +#endif + -- With a builtin polymorphic type for runSST the type for -- initTc should use TcM s r instead of TcM RealWorld r initTc :: UniqSupply - -> TcM _RealWorld r + -> TcM REAL_WORLD r -> MaybeErr (r, Bag Warning) (Bag Error, Bag Warning) @@ -465,7 +474,7 @@ getErrCtxt (TcDown def us loc ctxt errs) = ctxt %~~~~~~~~~~~~~~~~~~ \begin{code} -rnMtoTcM :: RnEnv -> RnM _RealWorld a -> NF_TcM s (a, Bag Error) +rnMtoTcM :: RnEnv -> RnM REAL_WORLD a -> NF_TcM s (a, Bag Error) rnMtoTcM rn_env rn_action down env = readMutVarSST u_var `thenSST` \ uniq_supply -> @@ -485,9 +494,9 @@ rnMtoTcM rn_env rn_action down env getImplicitUpRn `thenRn` \ implicit_env@(v_env,tc_env) -> if (isEmptyFM v_env && isEmptyFM tc_env) then returnRn result - else pprPanic "rnMtoTcM: non-empty ImplicitEnv!" - (ppAboves ([ ppCat [ppPStr m, ppPStr n] | (OrigName m n) <- keysFM v_env] - ++ [ ppCat [ppPStr m, ppPStr n] | (OrigName m n) <- keysFM tc_env])) + else panic "rnMtoTcM: non-empty ImplicitEnv!" +-- (ppAboves ([ ppCat [ppPStr m, ppPStr n] | (OrigName m n) <- keysFM v_env] +-- ++ [ ppCat [ppPStr m, ppPStr n] | (OrigName m n) <- keysFM tc_env])) ) in returnSST (rn_result, rn_errs)