[project @ 1999-12-02 15:52:19 by simonmar]

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

diff --git a/ghc/compiler/rename/RnNames.lhs b/ghc/compiler/rename/RnNames.lhs
index 9f46d36..fa5b376 100644 (file)
--- a/ghc/compiler/rename/RnNames.lhs
+++ b/ghc/compiler/rename/RnNames.lhs
@@ -216,9 +216,9 @@ checkEarlyExit mod
        -- Unchanged source, and no errors yet; see if usage info
        -- up to date, and exit if so
     checkUpToDate mod                                          `thenRn` \ up_to_date ->
-    putDocRn (text "Compilation" <+> 
-             text (if up_to_date then "IS NOT" else "IS") <+>
-             text "required")                                  `thenRn_`
+    (if up_to_date 
+       then putDocRn (text "Compilation IS NOT required")
+       else returnRn ())                                       `thenRn_`
     returnRn up_to_date
 \end{code}
        
@@ -273,10 +273,7 @@ importsFromLocalDecls mod_name rec_exp_fn decls
        all_names = [name | avail <- avails, name <- availNames avail]
 
        dups :: [[Name]]
-       dups = filter non_singleton (equivClassesByUniq getUnique all_names)
-            where
-               non_singleton (x1:x2:xs) = True
-               non_singleton other      = False
+       (_, dups) = removeDups compare all_names
     in
        -- Check for duplicate definitions
     mapRn_ (addErrRn . dupDeclErr) dups                `thenRn_` 
@@ -293,10 +290,19 @@ importsFromLocalDecls mod_name rec_exp_fn decls
                   (\n -> n)
 
   where
-    newLocalName rdr_name loc = newLocalTopBinder mod (rdrNameOcc rdr_name)
-                                                 rec_exp_fn loc
     mod = mkThisModule mod_name
 
+    newLocalName rdr_name loc 
+       = (if isQual rdr_name then
+               qualNameErr (text "the binding for" <+> quotes (ppr rdr_name)) (rdr_name,loc)
+               -- There should never be a qualified name in a binding position (except in instance decls)
+               -- The parser doesn't check this because the same parser parses instance decls
+           else 
+               returnRn ())                    `thenRn_`
+
+         newLocalTopBinder mod (rdrNameOcc rdr_name) rec_exp_fn loc
+
+
 getLocalDeclBinders :: (RdrName -> SrcLoc -> RnMG Name)        -- New-name function
                    -> RdrNameHsDecl
                    -> RnMG Avails
@@ -306,15 +312,6 @@ getLocalDeclBinders new_name (ValD binds)
     do_one (rdr_name, loc) = new_name rdr_name loc     `thenRn` \ name ->
                             returnRn (Avail name)
 
-    -- foreign declarations
-getLocalDeclBinders new_name (ForD (ForeignDecl nm kind _ dyn _ loc))
-  | binds_haskell_name kind dyn
-  = new_name nm loc                `thenRn` \ name ->
-    returnRn [Avail name]
-
-  | otherwise
-  = returnRn []
-
 getLocalDeclBinders new_name decl
   = getDeclBinders new_name decl       `thenRn` \ maybe_avail ->
     case maybe_avail of
@@ -326,10 +323,6 @@ getLocalDeclBinders new_name decl
        -- etc, into the cache
     new_sys_name rdr_name loc = newImplicitBinder (rdrNameOcc rdr_name) loc
 
-binds_haskell_name (FoImport _) _   = True
-binds_haskell_name FoLabel      _   = True
-binds_haskell_name FoExport  ext_nm = isDynamic ext_nm
-
 fixitiesFromLocalDecls :: GlobalRdrEnv -> [RdrNameHsDecl] -> RnMG FixityEnv
 fixitiesFromLocalDecls gbl_env decls
   = foldlRn getFixities emptyNameEnv decls
@@ -338,7 +331,7 @@ fixitiesFromLocalDecls gbl_env decls
     getFixities acc (FixD fix)
       = fix_decl acc fix
 
-    getFixities acc (TyClD (ClassDecl _ _ _ sigs _ _ _ _ _ _))
+    getFixities acc (TyClD (ClassDecl _ _ _ _ sigs _ _ _ _ _ _))
       = foldlRn fix_decl acc [sig | FixSig sig <- sigs]
                -- Get fixities from class decl sigs too.
     getFixities acc other_decl