projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
[project @ 1996-07-19 18:36:04 by partain]
[ghc-hetmet.git]
/
ghc
/
compiler
/
typecheck
/
TcMonad.lhs
diff --git
a/ghc/compiler/typecheck/TcMonad.lhs
b/ghc/compiler/typecheck/TcMonad.lhs
index
8a636e6
..
e595a83
100644
(file)
--- a/
ghc/compiler/typecheck/TcMonad.lhs
+++ b/
ghc/compiler/typecheck/TcMonad.lhs
@@
-2,7
+2,7
@@
#include "HsVersions.h"
module TcMonad(
#include "HsVersions.h"
module TcMonad(
- TcM(..), NF_TcM(..), TcDown, TcEnv,
+ SYN_IE(TcM), SYN_IE(NF_TcM), TcDown, TcEnv,
SST_R, FSST_R,
initTc,
SST_R, FSST_R,
initTc,
@@
-28,22
+28,26
@@
module TcMonad(
rnMtoTcM,
rnMtoTcM,
- TcError(..), TcWarning(..),
+ SYN_IE(TcError), SYN_IE(TcWarning),
mkTcErr, arityErr,
-- For closure
mkTcErr, arityErr,
-- For closure
- MutableVar(..), _MutableArray
+ SYN_IE(MutableVar),
+#if __GLASGOW_HASKELL__ >= 200
+ GHCbase.MutableArray
+#else
+ _MutableArray
+#endif
) where
IMP_Ubiq(){-uitous-}
) 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 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,
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 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 Outputable ( Outputable(..), NamedThing(..), ExportFlag )
-import ErrUtils ( SYN_IE(Error) )
import Maybes ( MaybeErr(..) )
--import Name ( Name )
import SrcLoc ( SrcLoc, mkUnknownSrcLoc )
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}
\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
-- 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)
-> MaybeErr (r, Bag Warning)
(Bag Error, Bag Warning)
@@
-465,7
+474,7
@@
getErrCtxt (TcDown def us loc ctxt errs) = ctxt
%~~~~~~~~~~~~~~~~~~
\begin{code}
%~~~~~~~~~~~~~~~~~~
\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 ->
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
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)
)
in
returnSST (rn_result, rn_errs)