only comments, spacing, alpha-renaming

[ghc-hetmet.git] / compiler / rename / RnEnv.lhs

diff --git a/compiler/rename/RnEnv.lhs b/compiler/rename/RnEnv.lhs
index d09c2ab..6f347da 100644 (file)
--- a/compiler/rename/RnEnv.lhs
+++ b/compiler/rename/RnEnv.lhs
@@ -15,6 +15,7 @@ module RnEnv (
        lookupLocatedInstDeclBndr,
        lookupSyntaxName, lookupSyntaxTable, lookupImportedName,
        lookupGreRn, lookupGreRn_maybe,
+       getLookupOccRn,
 
        newLocalsRn, newIPNameRn,
        bindLocalNames, bindLocalNamesFV,
@@ -114,7 +115,7 @@ newTopSrcBinder this_mod (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 (srcSpanStart loc) }
+       ; newGlobalBinder rdr_mod rdr_occ loc }
                --TODO, should pass the whole span
 
   | otherwise
@@ -122,7 +123,7 @@ newTopSrcBinder this_mod (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) (srcSpanStart loc) }
+       ; newGlobalBinder this_mod (rdrNameOcc rdr_name) loc }
 \end{code}
 
 %*********************************************************
@@ -174,7 +175,7 @@ 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 (srcSpanStart loc) }
+       ; newGlobalBinder rdr_mod rdr_occ loc }
 
   | otherwise
   = do { mb_gre <- lookupGreLocalRn rdr_name
@@ -194,8 +195,25 @@ lookupTopBndrRn rdr_name
 -- The Haskell98 report does not stipulate this, but it will!
 -- So we must treat the 'f' in the signature in the same way
 -- as the binding occurrence of 'f', using lookupBndrRn
+--
+-- However, consider this case:
+--     import M( f )
+--     f :: Int -> Int
+--     g x = x
+-- We don't want to say 'f' is out of scope; instead, we want to
+-- return the imported 'f', so that later on the reanamer will
+-- correctly report "misplaced type sig".
 lookupLocatedSigOccRn :: Located RdrName -> RnM (Located Name)
-lookupLocatedSigOccRn = lookupLocatedBndrRn
+lookupLocatedSigOccRn = wrapLocM $ \ rdr_name -> do
+       { local_env <- getLocalRdrEnv
+       ; case lookupLocalRdrEnv local_env rdr_name of {
+               Just n  -> return n ;
+               Nothing -> do
+       { mb_gre <- lookupGreLocalRn rdr_name
+       ; case mb_gre of 
+               Just gre -> return (gre_name gre) 
+               Nothing  -> lookupGlobalOccRn rdr_name
+       }}}
 
 -- lookupInstDeclBndr is used for the binders in an 
 -- instance declaration.   Here we use the class name to
@@ -255,6 +273,11 @@ lookupFamInstDeclBndr mod lrdr_name@(L _ rdr_name)
 --             Occurrences
 --------------------------------------------------
 
+getLookupOccRn :: RnM (Name -> Maybe Name)
+getLookupOccRn
+  = getLocalRdrEnv                     `thenM` \ local_env ->
+    return (lookupLocalRdrEnv local_env . mkRdrUnqual . nameOccName)
+
 lookupLocatedOccRn :: Located RdrName -> RnM (Located Name)
 lookupLocatedOccRn = wrapLocM lookupOccRn
 
@@ -603,7 +626,7 @@ newLocalsRn rdr_names_w_loc
        | otherwise = ASSERT2( isUnqual rdr_name, ppr rdr_name )
                        -- We only bind unqualified names here
                        -- lookupRdrEnv doesn't even attempt to look up a qualified RdrName
-                     mkInternalName uniq (rdrNameOcc rdr_name) (srcSpanStart loc)
+                     mkInternalName uniq (rdrNameOcc rdr_name) loc
 
 bindLocatedLocalsRn :: SDoc    -- Documentation string for error message
                    -> [Located RdrName]