[project @ 1998-01-12 09:29:22 by simonpj]

Fix renamer global/local env bug

diff --git a/ghc/compiler/reader/Lex.lhs b/ghc/compiler/reader/Lex.lhs
index f04e4ce..b312655 100644 (file)
--- a/ghc/compiler/reader/Lex.lhs
+++ b/ghc/compiler/reader/Lex.lhs
@@ -1,3 +1,16 @@
+--------------------------------------------------------
+[Jan 98]
+There's a known bug in here:
+
+       If an interface file ends prematurely, Lex tries to
+       do headFS of an empty FastString.
+
+An example that provokes the error is
+
+       f _:_ _forall_ [a] <<<END OF FILE>>>
+--------------------------------------------------------
+
+
 %
 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
 %

diff --git a/ghc/compiler/rename/RnBinds.lhs b/ghc/compiler/rename/RnBinds.lhs
index 18d47c0..046cd68 100644 (file)
--- a/ghc/compiler/rename/RnBinds.lhs
+++ b/ghc/compiler/rename/RnBinds.lhs
@@ -567,7 +567,7 @@ sig_doc (InlineSig  _     loc)          = (SLIT("INLINE pragma"),loc)
 sig_doc (MagicUnfoldingSig _ _ loc) = (SLIT("MAGIC_UNFOLDING pragma"),loc)
 
 missingSigErr var
-  = sep [ptext SLIT("a definition but no type signature for"), quotes (ppr var)]
+  = sep [ptext SLIT("Definition but no type signature for"), quotes (ppr var)]
 
 methodBindErr mbind
  =  hang (ptext SLIT("Can't handle multiple methods defined by one pattern binding"))

diff --git a/ghc/compiler/rename/RnEnv.lhs b/ghc/compiler/rename/RnEnv.lhs
index 89ecdf9..f975e91 100644 (file)
--- a/ghc/compiler/rename/RnEnv.lhs
+++ b/ghc/compiler/rename/RnEnv.lhs
@@ -19,7 +19,7 @@ import RnMonad
 import Name            ( Name, OccName(..), Provenance(..), ExportFlag(..), NamedThing(..),
                          occNameString, occNameFlavour, getSrcLoc,
                          NameSet, emptyNameSet, addListToNameSet, nameSetToList,
-                         mkLocalName, mkGlobalName, modAndOcc, isLocallyDefinedName,
+                         mkLocalName, mkGlobalName, modAndOcc,
                          nameOccName, setNameProvenance, isVarOcc, getNameProvenance,
                          pprProvenance, pprOccName, pprModule, pprNameProvenance,
                          isLocalName
@@ -447,16 +447,16 @@ addOneToGlobalNameEnv env rdr_name name
 delOneFromGlobalNameEnv :: GlobalNameEnv -> RdrName -> GlobalNameEnv 
 delOneFromGlobalNameEnv env rdr_name = delFromFM env rdr_name
 
-conflicting_name (n1,h1) (n2,h2) 
-  = (n1 /= n2) || 
-    (isLocallyDefinedName n1 && isLocallyDefinedName n2)
+conflicting_name :: (Name, HowInScope) -> (Name, HowInScope) -> Bool
+conflicting_name (n1, FromLocalDefn _) (n2, FromLocalDefn _) = True
+conflicting_name (n1,h1)              (n2,h2)               = n1 /= n2
        -- We complain of a conflict if one RdrName maps to two different Names,
        -- OR if one RdrName maps to the same *locally-defined* Name.  The latter
        -- case is to catch two separate, local definitions of the same thing.
        --
        -- If a module imports itself then there might be a local defn and an imported
        -- defn of the same name; in this case the names will compare as equal, but
-       -- will still have different provenances.
+       -- will still have different HowInScope fields
 
 lookupNameEnv :: NameEnv -> RdrName -> Maybe Name
 lookupNameEnv = lookupFM

diff --git a/ghc/compiler/rename/RnMonad.lhs b/ghc/compiler/rename/RnMonad.lhs
index 09cecfa..f20b714 100644 (file)
--- a/ghc/compiler/rename/RnMonad.lhs
+++ b/ghc/compiler/rename/RnMonad.lhs
@@ -619,9 +619,11 @@ lookupGlobalNameRn rdr_name rn_down (SDown (RnEnv global_env fixity_env) local_e
 -- Look in both local and global env
 lookupNameRn :: RdrName -> RnMS s (Maybe Name)
 lookupNameRn rdr_name rn_down (SDown (RnEnv global_env fixity_env) local_env mod_name mode)
-  = case lookupFM global_env rdr_name of
-         Just (name, _) -> returnSST (Just name)
-         Nothing        -> returnSST (lookupFM local_env rdr_name)
+  = case lookupFM local_env rdr_name of
+         Just name -> returnSST (Just name)
+         Nothing   -> case lookupFM global_env rdr_name of
+                         Just (name, _) -> returnSST (Just name)
+                         Nothing        -> returnSST Nothing
 
 getNameEnvs :: RnMS s (GlobalNameEnv, NameEnv)
 getNameEnvs rn_down (SDown (RnEnv global_env fixity_env) local_env mod_name mode)

diff --git a/ghc/compiler/rename/RnNames.lhs b/ghc/compiler/rename/RnNames.lhs
index 0574301..a3ff994 100644 (file)
--- a/ghc/compiler/rename/RnNames.lhs
+++ b/ghc/compiler/rename/RnNames.lhs
@@ -323,6 +323,7 @@ qualifyImports this_mod qual_imp unqual_imp as_mod hides
 
     add_avail :: GlobalNameEnv -> AvailInfo -> RnMG GlobalNameEnv
     add_avail env avail = foldlRn add_name env (availNames avail)
+
     add_name env name   = add qual_imp   env  (Qual qual_mod occ err_hif) `thenRn` \ env1 ->
                          add unqual_imp env1 (Unqual occ)
                        where
@@ -398,8 +399,8 @@ addAvailEnv warn_dups ie env NotAvailable   = returnRn env
 addAvailEnv warn_dups ie env (AvailTC _ []) = returnRn env
 addAvailEnv warn_dups ie env avail
   | warn_dups = mapMaybeRn (addErrRn  . availClashErr) () conflict `thenRn_`
-                returnRn (addToFM_C add_avail env key elt)
-  | otherwise = returnRn (addToFM_C add_avail env key elt)
+                returnRn (addToFM_C addAvail env key elt)
+  | otherwise = returnRn (addToFM_C addAvail env key elt)
   where
    key  = nameOccName (availName avail)
    elt  = (ie,avail,reports_on)
@@ -421,7 +422,7 @@ bad_avail  (ie1,avail1,r1) (ie2,avail2,r2)
 dup_avail  (ie1,avail1,r1) (ie2,avail2,r2) 
    = availName avail1 == availName avail2 -- Same OccName & avail.
 
-add_avail (ie1,a1,r1) (ie2,a2,r2) = (ie1, a1 `plusAvail` a2, r1 + r2)
+addAvail (ie1,a1,r1) (ie2,a2,r2) = (ie1, a1 `plusAvail` a2, r1 + r2)
 \end{code}
 
 Processing the export list.