projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
[project @ 2002-11-21 17:54:54 by simonpj]
[ghc-hetmet.git]
/
ghc
/
compiler
/
deSugar
/
DsMonad.lhs
diff --git
a/ghc/compiler/deSugar/DsMonad.lhs
b/ghc/compiler/deSugar/DsMonad.lhs
index
9a8b447
..
904d575
100644
(file)
--- a/
ghc/compiler/deSugar/DsMonad.lhs
+++ b/
ghc/compiler/deSugar/DsMonad.lhs
@@
-16,7
+16,7
@@
module DsMonad (
getModuleDs,
getUniqueDs, getUniquesDs,
getDOptsDs,
getModuleDs,
getUniqueDs, getUniquesDs,
getDOptsDs,
- dsLookupGlobalId, dsLookupTyCon,
+ dsLookupGlobal, dsLookupGlobalId, dsLookupTyCon,
DsMetaEnv, DsMetaVal(..), dsLookupMetaEnv, dsExtendMetaEnv,
DsMetaEnv, DsMetaVal(..), dsLookupMetaEnv, dsExtendMetaEnv,
@@
-31,7
+31,6
@@
import TcHsSyn ( TypecheckedPat, TypecheckedMatchContext, TypecheckedHsExpr )
import HscTypes ( TyThing(..) )
import Bag ( emptyBag, snocBag, Bag )
import TyCon ( TyCon )
import HscTypes ( TyThing(..) )
import Bag ( emptyBag, snocBag, Bag )
import TyCon ( TyCon )
-import ErrUtils ( WarnMsg )
import Id ( mkSysLocal, setIdUnique, Id )
import Module ( Module )
import Var ( TyVar, setTyVarUnique )
import Id ( mkSysLocal, setIdUnique, Id )
import Module ( Module )
import Var ( TyVar, setTyVarUnique )
@@
-84,7
+83,7
@@
instance Monad DsM where
type DsWarnings = Bag DsWarning -- The desugarer reports matches which are
-- completely shadowed or incomplete patterns
type DsWarnings = Bag DsWarning -- The desugarer reports matches which are
-- completely shadowed or incomplete patterns
-type DsWarning = (Loc, SDoc)
+type DsWarning = (SrcLoc, SDoc)
{-# INLINE thenDs #-}
{-# INLINE returnDs #-}
{-# INLINE thenDs #-}
{-# INLINE returnDs #-}
@@
-232,13
+231,19
@@
dsWarn warn = DsM(\ env warns -> returnUs ((), warns `snocBag` warn))
\end{code}
\begin{code}
\end{code}
\begin{code}
+dsLookupGlobal :: Name -> DsM TyThing
+dsLookupGlobal name
+ = DsM(\ env warns -> returnUs (ds_globals env name, warns))
+
dsLookupGlobalId :: Name -> DsM Id
dsLookupGlobalId :: Name -> DsM Id
-dsLookupGlobalId name = DsM(\ env warns ->
- returnUs (get_id name (ds_globals env name), warns))
+dsLookupGlobalId name
+ = dsLookupGlobal name `thenDs` \ thing ->
+ returnDs (get_id name thing)
dsLookupTyCon :: Name -> DsM TyCon
dsLookupTyCon :: Name -> DsM TyCon
-dsLookupTyCon name = DsM(\ env warns ->
- returnUs (get_tycon name (ds_globals env name), warns))
+dsLookupTyCon name
+ = dsLookupGlobal name `thenDs` \ thing ->
+ returnDs (get_tycon name thing)
get_id name (AnId id) = id
get_id name other = pprPanic "dsLookupGlobalId" (ppr name)
get_id name (AnId id) = id
get_id name other = pprPanic "dsLookupGlobalId" (ppr name)