Add quasi-quotation, courtesy of Geoffrey Mainland

[ghc-hetmet.git] / compiler / basicTypes / RdrName.lhs

diff --git a/compiler/basicTypes/RdrName.lhs b/compiler/basicTypes/RdrName.lhs
index 2090bea..a307a00 100644 (file)
--- a/compiler/basicTypes/RdrName.lhs
+++ b/compiler/basicTypes/RdrName.lhs
@@ -4,6 +4,13 @@
 %
 
 \begin{code}
+{-# OPTIONS -w #-}
+-- The above warning supression flag is a temporary kludge.
+-- While working on this module you are encouraged to remove it and fix
+-- any warnings in the module. See
+--     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
+-- for details
+
 module RdrName (
        RdrName(..),    -- Constructors exported only to BinIface
 
@@ -22,20 +29,21 @@ module RdrName (
 
        -- LocalRdrEnv
        LocalRdrEnv, emptyLocalRdrEnv, extendLocalRdrEnv,
-       lookupLocalRdrEnv, elemLocalRdrEnv,
+       lookupLocalRdrEnv, lookupLocalRdrOcc, elemLocalRdrEnv,
 
        -- GlobalRdrEnv
        GlobalRdrEnv, emptyGlobalRdrEnv, mkGlobalRdrEnv, plusGlobalRdrEnv, 
        lookupGlobalRdrEnv, extendGlobalRdrEnv,
        pprGlobalRdrEnv, globalRdrEnvElts,
-       lookupGRE_RdrName, lookupGRE_Name, hideSomeUnquals,
+       lookupGRE_RdrName, lookupGRE_Name, getGRE_NameQualifier_maybes,
+        hideSomeUnquals,
 
        -- GlobalRdrElt, Provenance, ImportSpec
        GlobalRdrElt(..), isLocalGRE, unQualOK, qualSpecOK, unQualSpecOK,
        Provenance(..), pprNameProvenance,
        Parent(..), 
        ImportSpec(..), ImpDeclSpec(..), ImpItemSpec(..), 
-       importSpecLoc, importSpecModule
+       importSpecLoc, importSpecModule, isExplicitItem
   ) where 
 
 #include "HsVersions.h"
@@ -268,6 +276,9 @@ lookupLocalRdrEnv env (Exact name) = Just name
 lookupLocalRdrEnv env (Unqual occ) = lookupOccEnv env occ
 lookupLocalRdrEnv env other       = Nothing
 
+lookupLocalRdrOcc :: LocalRdrEnv -> OccName -> Maybe Name
+lookupLocalRdrOcc env occ = lookupOccEnv env occ
+
 elemLocalRdrEnv :: RdrName -> LocalRdrEnv -> Bool
 elemLocalRdrEnv rdr_name env 
   | isUnqual rdr_name = rdrNameOcc rdr_name `elemOccEnv` env
@@ -302,6 +313,7 @@ data GlobalRdrElt
     }
 
 data Parent = NoParent | ParentIs Name
+             deriving (Eq)
 
 instance Outputable Parent where
    ppr NoParent     = empty
@@ -309,8 +321,20 @@ instance Outputable Parent where
    
 
 plusParent :: Parent -> Parent -> Parent
-plusParent NoParent     rel = ASSERT( case rel of { NoParent -> True; other -> False } )    NoParent
-plusParent (ParentIs n) rel = ASSERT( case rel of { ParentIs m -> n==m;  other -> False } ) ParentIs n
+plusParent p1 p2 = ASSERT2( p1 == p2, parens (ppr p1) <+> parens (ppr p2) )
+                   p1
+
+{- Why so complicated? -=chak
+plusParent :: Parent -> Parent -> Parent
+plusParent NoParent     rel = 
+  ASSERT2( case rel of { NoParent -> True; other -> False }, 
+          ptext SLIT("plusParent[NoParent]: ") <+> ppr rel )    
+  NoParent
+plusParent (ParentIs n) rel = 
+  ASSERT2( case rel of { ParentIs m -> n==m;  other -> False }, 
+          ptext SLIT("plusParent[ParentIs]:") <+> ppr n <> comma <+> ppr rel )
+  ParentIs n
+ -}
 
 emptyGlobalRdrEnv = emptyOccEnv
 
@@ -333,7 +357,7 @@ pprGlobalRdrEnv env
 
 \begin{code}
 lookupGlobalRdrEnv :: GlobalRdrEnv -> OccName -> [GlobalRdrElt]
-lookupGlobalRdrEnv env rdr_name = case lookupOccEnv env rdr_name of
+lookupGlobalRdrEnv env occ_name = case lookupOccEnv env occ_name of
                                        Nothing   -> []
                                        Just gres -> gres
 
@@ -354,6 +378,11 @@ lookupGRE_Name env name
   = [ gre | gre <- lookupGlobalRdrEnv env (nameOccName name),
            gre_name gre == name ]
 
+getGRE_NameQualifier_maybes :: GlobalRdrEnv -> Name -> [Maybe [ModuleName]]
+getGRE_NameQualifier_maybes env
+  = map qualifier_maybe . map gre_prov . lookupGRE_Name env
+  where qualifier_maybe LocalDef       = Nothing
+        qualifier_maybe (Imported iss) = Just $ map (is_as . is_decl) iss 
 
 pickGREs :: RdrName -> [GlobalRdrElt] -> [GlobalRdrElt]
 -- Take a list of GREs which have the right OccName
@@ -527,6 +556,10 @@ importSpecLoc (ImpSpec _    item)   = is_iloc item
 importSpecModule :: ImportSpec -> ModuleName
 importSpecModule is = is_mod (is_decl is)
 
+isExplicitItem :: ImpItemSpec -> Bool
+isExplicitItem ImpAll                       = False
+isExplicitItem (ImpSome {is_explicit = exp}) = exp
+
 -- Note [Comparing provenance]
 -- Comparison of provenance is just used for grouping 
 -- error messages (in RnEnv.warnUnusedBinds)