[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,
-       dsLookupGlobalId, dsLookupTyCon,
+       dsLookupGlobal, dsLookupGlobalId, dsLookupTyCon,
 
        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 ErrUtils        ( WarnMsg )
 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 DsWarning = (Loc, SDoc)
+type DsWarning = (SrcLoc, SDoc)
 
 {-# INLINE thenDs #-}
 {-# INLINE returnDs #-}
@@ -232,13 +231,19 @@ dsWarn warn = DsM(\ env warns -> returnUs ((), warns `snocBag` warn))
 \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(\ 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(\ 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)