Fix handling of family instances in the presense of this doc stuff
[ghc-hetmet.git] / compiler / rename / RnEnv.lhs
index 29a8791..16c1b0b 100644 (file)
@@ -1,5 +1,5 @@
 %
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
+% (c) The GRASP/AQUA Project, Glasgow University, 1992-2006
 %
 \section[RnEnv]{Environment manipulation for the renamer monad}
 
@@ -14,7 +14,7 @@ module RnEnv (
        lookupFixityRn, lookupTyFixityRn, lookupLocatedSigOccRn, 
        lookupLocatedInstDeclBndr,
        lookupSyntaxName, lookupSyntaxTable, lookupImportedName,
-       lookupGreRn,    
+       lookupGreRn, lookupGreRn_maybe,
 
        newLocalsRn, newIPNameRn,
        bindLocalNames, bindLocalNamesFV,
@@ -42,6 +42,7 @@ import RdrName                ( RdrName, isQual, isUnqual, isOrig_maybe,
                          mkRdrUnqual, setRdrNameSpace, rdrNameOcc,
                          pprGlobalRdrEnv, lookupGRE_RdrName, 
                          isExact_maybe, isSrcRdrName,
+                         Parent(..),
                          GlobalRdrElt(..), GlobalRdrEnv, lookupGlobalRdrEnv, 
                          isLocalGRE, extendLocalRdrEnv, elemLocalRdrEnv, lookupLocalRdrEnv,
                          Provenance(..), pprNameProvenance,
@@ -50,7 +51,7 @@ import RdrName                ( RdrName, isQual, isUnqual, isOrig_maybe,
 import HscTypes                ( availNames, ModIface(..), FixItem(..), lookupFixity )
 import TcRnMonad
 import Name            ( Name, nameIsLocalOrFrom, mkInternalName, isWiredInName,
-                         nameSrcLoc, nameOccName, nameModule, nameParent, isExternalName )
+                         nameSrcLoc, nameOccName, nameModule, isExternalName )
 import NameSet
 import OccName         ( tcName, isDataOcc, pprNonVarNameSpace, occNameSpace,
                          reportIfUnused )
@@ -75,8 +76,8 @@ import DynFlags
 %*********************************************************
 
 \begin{code}
-newTopSrcBinder :: Module -> Maybe Name -> Located RdrName -> RnM Name
-newTopSrcBinder this_mod mb_parent (L loc rdr_name)
+newTopSrcBinder :: Module -> Located RdrName -> RnM Name
+newTopSrcBinder this_mod (L loc rdr_name)
   | Just name <- isExact_maybe rdr_name
   =    -- This is here to catch 
        --   (a) Exact-name binders created by Template Haskell
@@ -113,7 +114,7 @@ newTopSrcBinder this_mod mb_parent (L loc rdr_name)
        -- the RdrName, not from the environment.  In principle, it'd be fine to 
        -- have an arbitrary mixture of external core definitions in a single module,
        -- (apart from module-initialisation issues, perhaps).
-       ; newGlobalBinder rdr_mod rdr_occ mb_parent (srcSpanStart loc) }
+       ; newGlobalBinder rdr_mod rdr_occ (srcSpanStart loc) }
                --TODO, should pass the whole span
 
   | otherwise
@@ -121,7 +122,7 @@ newTopSrcBinder this_mod mb_parent (L loc rdr_name)
                 (addErrAt loc (badQualBndrErr rdr_name))
                -- Binders should not be qualified; if they are, and with a different
                -- module name, we we get a confusing "M.T is not in scope" error later
-       ; newGlobalBinder this_mod (rdrNameOcc rdr_name) mb_parent (srcSpanStart loc) }
+       ; newGlobalBinder this_mod (rdrNameOcc rdr_name) (srcSpanStart loc) }
 \end{code}
 
 %*********************************************************
@@ -173,12 +174,14 @@ lookupTopBndrRn rdr_name
        -- we don't bother to call newTopSrcBinder first
        -- We assume there is no "parent" name
   = do { loc <- getSrcSpanM
-       ; newGlobalBinder rdr_mod rdr_occ Nothing (srcSpanStart loc) }
+       ; newGlobalBinder rdr_mod rdr_occ (srcSpanStart loc) }
 
   | otherwise
   = do { mb_gre <- lookupGreLocalRn rdr_name
        ; case mb_gre of
-               Nothing  -> unboundName rdr_name
+               Nothing  -> do
+                             traceRn $ text "lookupTopBndrRn"
+                             unboundName rdr_name
                Just gre -> returnM (gre_name gre) }
              
 -- lookupLocatedSigOccRn is used for type signatures and pragmas
@@ -199,19 +202,27 @@ lookupLocatedSigOccRn = lookupLocatedBndrRn
 -- disambiguate.  
 
 lookupLocatedInstDeclBndr :: Name -> Located RdrName -> RnM (Located Name)
-lookupLocatedInstDeclBndr cls = wrapLocM (lookupInstDeclBndr cls)
+lookupLocatedInstDeclBndr cls rdr = wrapLocM (lookupInstDeclBndr cls) rdr
 
 lookupInstDeclBndr :: Name -> RdrName -> RnM Name
+-- This is called on the method name on the left-hand side of an 
+-- instance declaration binding. eg.  instance Functor T where
+--                                       fmap = ...
+--                                       ^^^^ called on this
+-- Regardless of how many unqualified fmaps are in scope, we want
+-- the one that comes from the Functor class.
 lookupInstDeclBndr cls_name rdr_name
   | isUnqual rdr_name  -- Find all the things the rdr-name maps to
   = do {               -- and pick the one with the right parent name
-         let { is_op gre     = cls_name == nameParent (gre_name gre)
+         let { is_op gre@(GRE {gre_par = ParentIs n}) = cls_name == n
+             ; is_op other                            = False
              ; occ           = rdrNameOcc rdr_name
              ; lookup_fn env = filter is_op (lookupGlobalRdrEnv env occ) }
        ; mb_gre <- lookupGreRn_help rdr_name lookup_fn
        ; case mb_gre of
            Just gre -> return (gre_name gre)
            Nothing  -> do { addErr (unknownInstBndrErr cls_name rdr_name)
+                          ; traceRn (text "lookupInstDeclBndr" <+> ppr rdr_name)
                           ; return (mkUnboundName rdr_name) } }
 
   | otherwise  -- Occurs in derived instances, where we just
@@ -235,15 +246,10 @@ newIPNameRn ip_rdr = newIPName (mapIPName rdrNameOcc ip_rdr)
 --
 lookupFamInstDeclBndr :: Module -> Located RdrName -> RnM Name
 lookupFamInstDeclBndr mod lrdr_name@(L _ rdr_name)
-  | not (isSrcRdrName rdr_name)
-  = lookupImportedName rdr_name        
-
-  | otherwise
-  =    -- First look up the name in the normal environment.
-   lookupGreRn rdr_name                        `thenM` \ mb_gre ->
-   case mb_gre of {
-       Just gre -> returnM (gre_name gre) ;
-       Nothing  -> newTopSrcBinder mod Nothing lrdr_name }
+  = do { mb_gre <- lookupGreRn_maybe rdr_name
+       ; case mb_gre of
+           Just gre -> returnM (gre_name gre) ;
+          Nothing  -> newTopSrcBinder mod lrdr_name }
 
 --------------------------------------------------
 --             Occurrences
@@ -275,7 +281,7 @@ lookupGlobalOccRn rdr_name
 
   | otherwise
   =    -- First look up the name in the normal environment.
-   lookupGreRn rdr_name                        `thenM` \ mb_gre ->
+   lookupGreRn_maybe rdr_name          `thenM` \ mb_gre ->
    case mb_gre of {
        Just gre -> returnM (gre_name gre) ;
        Nothing   -> 
@@ -288,7 +294,8 @@ lookupGlobalOccRn rdr_name
    if isQual rdr_name && mod == iNTERACTIVE then       
                                        -- This test is not expensive,
        lookupQualifiedName rdr_name    -- and only happens for failed lookups
-   else        
+   else        do
+        traceRn $ text "lookupGlobalOccRn"
        unboundName rdr_name }
 
 lookupImportedName :: RdrName -> TcRnIf m n Name
@@ -326,17 +333,29 @@ unboundName rdr_name
 lookupSrcOcc_maybe :: RdrName -> RnM (Maybe Name)
 -- No filter function; does not report an error on failure
 lookupSrcOcc_maybe rdr_name
-  = do { mb_gre <- lookupGreRn rdr_name
+  = do { mb_gre <- lookupGreRn_maybe rdr_name
        ; case mb_gre of
                Nothing  -> returnM Nothing
                Just gre -> returnM (Just (gre_name gre)) }
        
 -------------------------
-lookupGreRn :: RdrName -> RnM (Maybe GlobalRdrElt)
+lookupGreRn_maybe :: RdrName -> RnM (Maybe GlobalRdrElt)
 -- Just look up the RdrName in the GlobalRdrEnv
-lookupGreRn rdr_name 
+lookupGreRn_maybe rdr_name 
   = lookupGreRn_help rdr_name (lookupGRE_RdrName rdr_name)
 
+lookupGreRn :: RdrName -> RnM GlobalRdrElt
+-- If not found, add error message, and return a fake GRE
+lookupGreRn rdr_name 
+  = do { mb_gre <- lookupGreRn_maybe rdr_name
+       ; case mb_gre of {
+           Just gre -> return gre ;
+           Nothing  -> do
+       { traceRn $ text "lookupGreRn"
+       ; name <- unboundName rdr_name
+       ; return (GRE { gre_name = name, gre_par = NoParent,
+                       gre_prov = LocalDef }) }}}
+
 lookupGreLocalRn :: RdrName -> RnM (Maybe GlobalRdrElt)
 -- Similar, but restricted to locally-defined things
 lookupGreLocalRn rdr_name