[project @ 1997-06-18 23:52:36 by simonpj]
[ghc-hetmet.git] / ghc / compiler / rename / RnNames.lhs
index 5db5ead..4e745f1 100644 (file)
@@ -14,16 +14,16 @@ IMP_Ubiq()
 
 import CmdLineOpts     ( opt_SourceUnchanged, opt_NoImplicitPrelude )
 import HsSyn   ( HsModule(..), HsDecl(..), FixityDecl(..), Fixity, Fake, InPat, IE(..), HsTyVar,
-                 TyDecl, ClassDecl, InstDecl, DefaultDecl, ImportDecl(..), HsBinds, IfaceSig
+                 TyDecl, ClassDecl, InstDecl, DefaultDecl, ImportDecl(..), HsBinds, IfaceSig,
+                 collectTopBinders
                )
-import HsBinds ( collectTopBinders )
 import HsImpExp        ( ieName )
 import RdrHsSyn        ( RdrNameHsDecl(..), RdrName(..), RdrNameIE(..), SYN_IE(RdrNameImportDecl),
                  SYN_IE(RdrNameHsModule), SYN_IE(RdrNameFixityDecl),
-                 rdrNameOcc
+                 rdrNameOcc, ieOcc
                )
 import RnHsSyn ( RenamedHsModule(..), RenamedFixityDecl(..) )
-import RnIfaces        ( getInterfaceExports, getDeclBinders, checkUpToDate )
+import RnIfaces        ( getInterfaceExports, getDeclBinders, checkUpToDate, recordSlurp )
 import RnEnv
 import RnMonad
 import FiniteMap
@@ -33,8 +33,8 @@ import Bag    ( Bag, bagToList )
 import Maybes  ( maybeToBool, expectJust )
 import Name
 import Pretty
-import PprStyle        ( PprStyle(..) )
-import Util    ( panic, pprTrace )
+import Outputable      ( Outputable(..), PprStyle(..) )
+import Util    ( panic, pprTrace, assertPanic )
 \end{code}
 
 
@@ -47,8 +47,11 @@ import Util  ( panic, pprTrace )
 
 \begin{code}
 getGlobalNames :: RdrNameHsModule
-              -> RnMG (Maybe (ExportEnv, RnEnv, [AvailInfo]))
+              -> RnMG (Maybe (ExportEnv, RnEnv, NameSet))
                        -- Nothing <=> no need to recompile
+                       -- The NameSet is the set of names that are
+                       --      either locally defined,
+                       --      or explicitly imported
 
 getGlobalNames m@(HsModule this_mod _ exports imports _ _ mod_loc)
   = fixRn (\ ~(rec_exp_fn, _) ->
@@ -56,11 +59,11 @@ getGlobalNames m@(HsModule this_mod _ exports imports _ _ mod_loc)
        -- PROCESS LOCAL DECLS
        -- Do these *first* so that the correct provenance gets
        -- into the global name cache.
-      importsFromLocalDecls rec_exp_fn m       `thenRn` \ (local_rn_env, local_mod_avails) ->
+      importsFromLocalDecls rec_exp_fn m       `thenRn` \ (local_rn_env, local_mod_avails, local_avails) ->
 
        -- PROCESS IMPORT DECLS
-      mapAndUnzipRn importsFromImportDecl all_imports
-                                               `thenRn` \ (imp_rn_envs, imp_avails_s) ->
+      mapAndUnzip3Rn importsFromImportDecl all_imports
+                                               `thenRn` \ (imp_rn_envs, imp_avails_s, explicit_imports_s) ->
 
        -- CHECK FOR EARLY EXIT
       checkEarlyExit this_mod                  `thenRn` \ early_exit ->
@@ -69,21 +72,27 @@ getGlobalNames m@(HsModule this_mod _ exports imports _ _ mod_loc)
       else
 
        -- COMBINE RESULTS
-       -- We put the local env first, so that a local provenance
+       -- We put the local env second, so that a local provenance
        -- "wins", even if a module imports itself.
       foldlRn plusRnEnv emptyRnEnv imp_rn_envs         `thenRn` \ imp_rn_env ->
-      plusRnEnv local_rn_env imp_rn_env                        `thenRn` \ rn_env ->
+      plusRnEnv imp_rn_env local_rn_env                        `thenRn` \ rn_env ->
       let
-        all_avails :: ModuleAvails
-        all_avails = foldr plusModuleAvails local_mod_avails imp_avails_s
-        local_avails = expectJust "getGlobalNames" (lookupModuleAvails local_mod_avails this_mod)
+        export_avails :: ExportAvails
+        export_avails = foldr plusExportAvails local_mod_avails imp_avails_s
+
+        explicit_names :: NameSet      -- locally defined or explicitly imported
+        explicit_names = foldr add_on emptyNameSet (local_avails : explicit_imports_s)
+        add_on avails names = foldr (unionNameSets . mkNameSet . availNames) names avails
       in
   
        -- PROCESS EXPORT LISTS
-      exportsFromAvail this_mod exports all_avails rn_env      
+      exportsFromAvail this_mod exports export_avails rn_env   
                                                        `thenRn` \ (export_fn, export_env) ->
 
-      returnRn (export_fn, Just (export_env, rn_env, local_avails))
+       -- RECORD THAT LOCALLY DEFINED THINGS ARE AVAILABLE
+      mapRn (recordSlurp Nothing Compulsory) local_avails      `thenRn_`
+
+      returnRn (export_fn, Just (export_env, rn_env, explicit_names))
     )                                                  `thenRn` \ (_, result) ->
     returnRn result
   where
@@ -101,51 +110,63 @@ getGlobalNames m@(HsModule this_mod _ exports imports _ _ mod_loc)
 
                 | otherwise               = [ImportDecl pRELUDE 
                                                         False          {- Not qualified -}
+                                                        False          {- Not source imported -}
                                                         Nothing        {- No "as" -}
                                                         Nothing        {- No import list -}
                                                         mod_loc]
     
     explicit_prelude_import
-      = not (null [ () | (ImportDecl mod qual _ _ _) <- imports, mod == pRELUDE ])
+      = not (null [ () | (ImportDecl mod qual _ _ _ _) <- imports, mod == pRELUDE ])
 \end{code}
        
 \begin{code}
 checkEarlyExit mod
-  = if not opt_SourceUnchanged then
-       -- Source code changed; look no further
-       returnRn False
+  = checkErrsRn                                `thenRn` \ no_errs_so_far ->
+    if not no_errs_so_far then
+       -- Found errors already, so exit now
+       returnRn True
     else
-       -- Unchanged source; look further
-       -- We check for 
-       --      (a) errors so far.  These can arise if a module imports
-       --          something that's no longer exported by the imported module
-       --      (b) usage information up to date
-       checkErrsRn                             `thenRn` \ no_errs_so_far ->
-       checkUpToDate mod                       `thenRn` \ up_to_date ->
-       returnRn (no_errs_so_far && up_to_date)
+    traceRn (text "Considering whether compilation is required...")    `thenRn_`
+    (if not opt_SourceUnchanged then
+       -- Source code changed and no errors yet... carry on 
+       traceRn (nest 4 (text "source file changed"))                   `thenRn_` 
+       returnRn False
+     else
+       -- Unchanged source, and no errors yet; see if usage info
+       -- up to date, and exit if so
+       checkUpToDate mod
+    )                                                                  `thenRn` \ up_to_date ->
+    traceRn (text "Hence, compilation" <+> 
+            text (if up_to_date then "IS NOT" else "IS") <+>
+            text "required")                                           `thenRn_`
+    returnRn up_to_date
 \end{code}
        
 
 \begin{code}
 importsFromImportDecl :: RdrNameImportDecl
-                     -> RnMG (RnEnv, ModuleAvails)
+                     -> RnMG (RnEnv, ExportAvails, [AvailInfo])
 
-importsFromImportDecl (ImportDecl mod qual_only as_mod import_spec loc)
+importsFromImportDecl (ImportDecl mod qual_only as_source as_mod import_spec loc)
   = pushSrcLocRn loc $
-    getInterfaceExports mod                    `thenRn` \ (avails, fixities) ->
-    filterImports mod import_spec avails       `thenRn` \ filtered_avails ->
+    getInterfaceExports mod as_source          `thenRn` \ (avails, fixities) ->
+    filterImports mod import_spec avails       `thenRn` \ (filtered_avails, hides, explicits) ->
     let
-       filtered_avails' = [ Avail (set_name_prov n) (map set_name_prov ns)
-                          | Avail n ns <- filtered_avails
-                          ]
-       fixities'        = [ (occ,fixity,provenance) | (occ,fixity) <- fixities ]
+       filtered_avails' = map set_avail_prov filtered_avails
+       fixities'        = [ (occ,(fixity,provenance)) | (occ,fixity) <- fixities ]
     in
     qualifyImports mod 
                   True                 -- Want qualified names
                   (not qual_only)      -- Maybe want unqualified names
                   as_mod
                   (ExportEnv filtered_avails' fixities')
+                  hides
+                                                       `thenRn` \ (rn_env, mod_avails) ->
+    returnRn (rn_env, mod_avails, explicits)
   where
+    set_avail_prov NotAvailable   = NotAvailable
+    set_avail_prov (Avail n)      = Avail (set_name_prov n) 
+    set_avail_prov (AvailTC n ns) = AvailTC (set_name_prov n) (map set_name_prov ns)
     set_name_prov name = setNameProvenance name provenance
     provenance = Imported mod loc
 \end{code}
@@ -160,6 +181,9 @@ importsFromLocalDecls rec_exp_fn (HsModule mod _ _ _ fix_decls decls _)
                   True         -- Want unqualified names
                   Nothing      -- No "as M" part
                   (ExportEnv avails fixities)
+                  []           -- Hide nothing
+                                                       `thenRn` \ (rn_env, mod_avails) ->
+    returnRn (rn_env, mod_avails, avails)
   where
     newLocalName rdr_name loc
       = newLocallyDefinedGlobalName mod (rdrNameOcc rdr_name) rec_exp_fn loc
@@ -170,11 +194,13 @@ importsFromLocalDecls rec_exp_fn (HsModule mod _ _ _ fix_decls decls _)
 
     getLocalDeclBinders avails decl
       = getDeclBinders newLocalName decl       `thenRn` \ avail ->
-       returnRn (avail : avails)
+       case avail of
+          NotAvailable -> returnRn avails              -- Instance decls and suchlike
+          other        -> returnRn (avail : avails)
 
     do_one (rdr_name, loc)
       = newLocalName rdr_name loc      `thenRn` \ name ->
-        returnRn (Avail name [])
+        returnRn (Avail name)
 \end{code}
 
 %************************************************************************
@@ -190,55 +216,45 @@ available, and filters it through the import spec (if any).
 filterImports :: Module
              -> Maybe (Bool, [RdrNameIE])              -- Import spec; True => hidin
              -> [AvailInfo]                            -- What's available
-             -> RnMG [AvailInfo]                       -- What's actually imported
-       -- Complains if import spec mentions things the
-       -- module doesn't export
+             -> RnMG ([AvailInfo],                     -- What's actually imported
+                      [AvailInfo],                     -- What's to be hidden (the unqualified version, that is)
+                      [AvailInfo])                     -- What was imported explicitly
+
+       -- Complains if import spec mentions things that the module doesn't export
 
 filterImports mod Nothing imports
-  = returnRn imports
+  = returnRn (imports, [], [])
 
 filterImports mod (Just (want_hiding, import_items)) avails
-  =    -- Check that each import item mentions things that are actually available
-    mapRn check_import_item import_items       `thenRn_`
-
-       -- Return filtered environment; no need to filter fixities
-    returnRn (map new_avail avails)
+  = mapRn check_item import_items              `thenRn` \ item_avails ->
+    if want_hiding 
+    then       
+       returnRn (avails, item_avails, [])      -- All imported; item_avails to be hidden
+    else
+       returnRn (item_avails, [], item_avails) -- Just item_avails imported; nothing to be hidden
 
   where
-    import_fm :: FiniteMap OccName RdrNameIE
-    import_fm = listToFM [(ieOcc ie, ie) | ie <- import_items]
-
-    avail_fm :: FiniteMap OccName AvailInfo
-    avail_fm = listToFM [(nameOccName name, avail) | avail@(Avail name ns) <- avails]
-
-    new_avail NotAvailable = NotAvailable
-    new_avail avail@(Avail name _)
-       | not in_import_items && want_hiding     = avail
-       | not in_import_items && not want_hiding = NotAvailable
-       | in_import_items     && want_hiding     = NotAvailable
-       | in_import_items     && not want_hiding = filtered_avail
-       where
-         maybe_import_item = lookupFM import_fm (nameOccName name)
-         in_import_items   = maybeToBool maybe_import_item
-         Just import_item  = maybe_import_item
-         filtered_avail    = filterAvail import_item avail
-
-    check_import_item  :: RdrNameIE -> RnMG ()
-    check_import_item item
-      = checkRn (maybeToBool maybe_matching_avail && sub_names_ok item avail)
-               (badImportItemErr mod item)
-     where
-       item_name            = ieOcc item
-       maybe_matching_avail = lookupFM avail_fm item_name
-       Just avail          = maybe_matching_avail
-
-    sub_names_ok (IEVar _)             _             = True
-    sub_names_ok (IEThingAbs _)                _             = True
-    sub_names_ok (IEThingAll _)                _             = True
-    sub_names_ok (IEThingWith _ wanted) (Avail _ has) = all ((`elem` has_list) . rdrNameOcc) wanted
-                                                     where
-                                                       has_list = map nameOccName has
-    sub_names_ok other1                        other2        = False
+    import_fm :: FiniteMap OccName AvailInfo
+    import_fm = listToFM [ (nameOccName name, avail) 
+                        | avail <- avails,
+                          name  <- availEntityNames avail]
+
+    check_item item@(IEModuleContents _)
+      = addErrRn (badImportItemErr mod item)   `thenRn_`
+       returnRn NotAvailable
+
+    check_item item
+      | not (maybeToBool maybe_in_import_avails) ||
+       (case filtered_avail of { NotAvailable -> True; other -> False })
+      = addErrRn (badImportItemErr mod item)   `thenRn_`
+       returnRn NotAvailable
+
+      | otherwise   = returnRn filtered_avail
+               
+      where
+       maybe_in_import_avails = lookupFM import_fm (ieOcc item)
+       Just avail             = maybe_in_import_avails
+       filtered_avail         = filterAvail item avail
 \end{code}
 
 
@@ -251,7 +267,7 @@ filterImports mod (Just (want_hiding, import_items)) avails
 
 @qualifyImports@ takes the @ExportEnv@ after filtering through the import spec
 of an import decl, and deals with producing an @RnEnv@ with the 
-right qaulified names.  It also turns the @Names@ in the @ExportEnv@ into
+right qualified names.  It also turns the @Names@ in the @ExportEnv@ into
 fully fledged @Names@.
 
 \begin{code}
@@ -260,47 +276,53 @@ qualifyImports :: Module                          -- Imported module
               -> Bool                                  -- True <=> want unqualified import
               -> Maybe Module                          -- Optional "as M" part 
               -> ExportEnv                             -- What's imported
-              -> RnMG (RnEnv, ModuleAvails)
+              -> [AvailInfo]                           -- What's to be hidden
+              -> RnMG (RnEnv, ExportAvails)
+
+qualifyImports this_mod qual_imp unqual_imp as_mod (ExportEnv avails fixities) hides
+  = 
+       -- Make the name environment.  Even though we're talking about a 
+       -- single import module there might still be name clashes, 
+       -- because it might be the module being compiled.
+    foldlRn add_avail emptyNameEnv avails      `thenRn` \ name_env1 ->
+    let
+       -- Delete things that are hidden
+       name_env2 = foldl del_avail name_env1 hides
+
+       -- Create the fixity env
+       fixity_env = foldl (add_fixity name_env2) emptyFixityEnv fixities
 
-qualifyImports this_mod qual_imp unqual_imp as_mod (ExportEnv avails fixities)
-  =    -- Make the qualified-name environments, checking of course for clashes
-    foldlRn add_name emptyNameEnv avails                       `thenRn` \ name_env ->
-    foldlRn (add_fixity name_env) emptyFixityEnv fixities      `thenRn` \ fixity_env ->
-    returnRn (RnEnv name_env fixity_env, mod_avail_env)
+       -- Create the export-availability info
+       export_avails = mkExportAvails unqual_imp qual_mod avails
+    in
+    returnRn (RnEnv name_env2 fixity_env, export_avails)
   where
     qual_mod = case as_mod of
                  Nothing           -> this_mod
                  Just another_name -> another_name
 
-    mod_avail_env  = unitFM qual_mod avails
-
-    add_name name_env NotAvailable = returnRn name_env
-    add_name name_env (Avail n ns) = foldlRn add_one name_env (n : ns)
-
-    add_one :: NameEnv -> Name -> RnMG NameEnv
-    add_one env name = add_to_env addOneToNameEnvRn env occ_name name
-                    where
-                       occ_name = nameOccName name
-
-    add_to_env add_fn env occ thing | qual_imp && unqual_imp = both
-                                   | qual_imp               = qual_only
-                                   | unqual_imp             = unqual_only
-                               where
-                                 unqual_only = add_fn env  (Unqual occ)        thing
-                                 qual_only   = add_fn env  (Qual qual_mod occ) thing
-                                 both        = unqual_only     `thenRn` \ env' ->
-                                               add_fn env' (Qual qual_mod occ) thing
+    add_avail env avail = foldlRn add_name env (availNames avail)
+    add_name env name   = add qual_imp   env  (Qual qual_mod occ)      `thenRn` \ env1 ->
+                         add unqual_imp env1 (Unqual occ)
+                       where
+                         add False env rdr_name = returnRn env
+                         add True  env rdr_name = addOneToNameEnv env rdr_name name
+                         occ  = nameOccName name
+
+    del_avail env avail = foldl delOneFromNameEnv env rdr_names
+                       where
+                         rdr_names = map (Unqual . nameOccName) (availNames avail)
                        
-    add_fixity name_env fixity_env (occ_name, fixity, provenance)
-       | maybeToBool (lookupFM name_env rdr_name)      -- It's imported
-       = add_to_env addOneToFixityEnvRn fixity_env occ_name (fixity,provenance)
-       | otherwise                                     -- It ain't imported
-       = returnRn fixity_env
-       where
-               -- rdr_name is a name by which the thing is guaranteed to be known,
-               -- *if it is imported at all*
-         rdr_name | qual_imp  = Qual qual_mod occ_name
-                  | otherwise = Unqual occ_name
+    add_fixity name_env fix_env (occ_name, (fixity, provenance))
+       = add qual $ add unqual $ fix_env
+       where
+         qual   = Qual qual_mod occ_name
+         unqual = Unqual occ_name
+
+         add rdr_name fix_env | maybeToBool (lookupFM name_env rdr_name)
+                              = addOneToFixityEnv fix_env rdr_name (fixity,provenance)
+                              | otherwise
+                              = fix_env
 \end{code}
 
 unQualify adds an Unqual binding for every existing Qual binding.
@@ -318,10 +340,10 @@ unQualify fm = addListToFM fm [(Unqual occ, elt) | (Qual _ occ, elt) <- fmToList
 
 
 \begin{code}
-fixityFromFixDecl :: RdrNameFixityDecl -> RnMG (OccName, Fixity, Provenance)
+fixityFromFixDecl :: RdrNameFixityDecl -> RnMG (OccName, (Fixity, Provenance))
 
 fixityFromFixDecl (FixityDecl rdr_name fixity loc)
-  = returnRn (rdrNameOcc rdr_name, fixity, LocalDef (panic "export-flag") loc)
+  = returnRn (rdrNameOcc rdr_name, (fixity, LocalDef (panic "export-flag") loc))
 \end{code}
 
 
@@ -344,10 +366,9 @@ type AvailEnv = FiniteMap OccName (RdrNameIE, AvailInfo)
 emptyAvailEnv = emptyFM
 
 unitAvailEnv :: RdrNameIE -> AvailInfo -> AvailEnv
-unitAvailEnv ie NotAvailable
-  = emptyFM
-unitAvailEnv ie avail@(Avail n ns)
-  = unitFM (nameOccName n) (ie,avail)
+unitAvailEnv ie NotAvailable   = emptyFM
+unitAvailEnv ie (AvailTC _ []) = emptyFM
+unitAvailEnv ie avail         = unitFM (nameOccName (availName avail)) (ie,avail)
 
 plusAvailEnv a1 a2
   = mapRn (addErrRn.availClashErr) (conflictsFM bad_avail a1 a2)       `thenRn_`
@@ -357,23 +378,33 @@ listToAvailEnv :: RdrNameIE -> [AvailInfo] -> RnM s d AvailEnv
 listToAvailEnv ie items
   = foldlRn plusAvailEnv emptyAvailEnv (map (unitAvailEnv ie) items)
 
-bad_avail  (ie1,Avail n1 _) (ie2,Avail n2 _) = n1 /= n2        -- Same OccName, different Name
+bad_avail  (ie1,avail1) (ie2,avail2) = availName avail1 /= availName avail2    -- Same OccName, different Name
 plus_avail (ie1,a1) (ie2,a2) = (ie1, a1 `plusAvail` a2)
 \end{code}
 
+Processing the export list.
+
+You might think that we should record things that appear in the export list as
+``occurrences'' (using addOccurrenceName), but you'd be wrong.  We do check (here)
+that they are in scope, but there is no need to slurp in their actual declaration
+(which is what addOccurrenceName forces).  Indeed, doing so would big trouble when
+compiling PrelBase, because it re-exports GHC, which includes takeMVar#, whose type
+includes ConcBase.StateAndSynchVar#, and so on...
 
 \begin{code}
 exportsFromAvail :: Module
                 -> Maybe [RdrNameIE]   -- Export spec
-                -> ModuleAvails
+                -> ExportAvails
                 -> RnEnv
                 -> RnMG (Name -> ExportFlag, ExportEnv)
        -- Complains if two distinct exports have same OccName
        -- Complains about exports items not in scope
-exportsFromAvail this_mod Nothing all_avails rn_env
-  = exportsFromAvail this_mod (Just [IEModuleContents this_mod]) all_avails rn_env
+exportsFromAvail this_mod Nothing export_avails rn_env
+  = exportsFromAvail this_mod (Just [IEModuleContents this_mod]) export_avails rn_env
 
-exportsFromAvail this_mod (Just export_items) all_avails (RnEnv name_env fixity_env)
+exportsFromAvail this_mod (Just export_items) 
+                (mod_avail_env, entity_avail_env)
+                (RnEnv name_env fixity_env)
   = mapRn exports_from_item export_items               `thenRn` \ avail_envs ->
     foldlRn plusAvailEnv emptyAvailEnv avail_envs      `thenRn` \ export_avail_env -> 
     let
@@ -384,18 +415,11 @@ exportsFromAvail this_mod (Just export_items) all_avails (RnEnv name_env fixity_
     returnRn (export_fn, ExportEnv export_avails export_fixities)
 
   where
-    full_avail_env :: UniqFM AvailInfo
-    full_avail_env = addListToUFM_C plusAvail emptyUFM
-                          [(name,avail) | avail@(Avail name _) <- concat (eltsFM all_avails)]
-       -- NB: full_avail_env won't contain bindings for data constructors and class ops,
-       -- which is right and proper; attempts to export them on their own will provoke an error
-
     exports_from_item :: RdrNameIE -> RnMG AvailEnv
     exports_from_item ie@(IEModuleContents mod)
-       = case lookupFM all_avails mod of
+       = case lookupFM mod_avail_env mod of
                Nothing     -> failWithRn emptyAvailEnv (modExportErr mod)
-               Just avails -> addOccurrenceNames Compulsory [n | Avail n _ <- avails]  `thenRn_`
-                              listToAvailEnv ie avails
+               Just avails -> listToAvailEnv ie avails
 
     exports_from_item ie
        | not (maybeToBool maybe_in_scope) 
@@ -413,23 +437,56 @@ exportsFromAvail this_mod (Just export_items) all_avails (RnEnv name_env fixity_
        = failWithRn emptyAvailEnv (exportItemErr ie export_avail)
 
        | otherwise     -- Phew!  It's OK!
-       = addOccurrenceName Compulsory name     `thenRn_`
-         returnRn (unitAvailEnv ie export_avail)
+       = returnRn (unitAvailEnv ie export_avail)
        where
           maybe_in_scope  = lookupNameEnv name_env (ieName ie)
          Just name       = maybe_in_scope
-         maybe_avail     = lookupUFM full_avail_env name
+         maybe_avail     = lookupUFM entity_avail_env name
          Just avail      = maybe_avail
          export_avail    = filterAvail ie avail
          enough_avail    = case export_avail of {NotAvailable -> False; other -> True}
 
        -- We export a fixity iff we export a thing with the same (qualified) RdrName
-    mk_exported_fixities :: NameSet -> [(OccName, Fixity, Provenance)]
+    mk_exported_fixities :: NameSet -> [(OccName, (Fixity, Provenance))]
     mk_exported_fixities exports
-       = [ (rdrNameOcc rdr_name, fixity, prov)
-         | (rdr_name, (fixity, prov)) <- fmToList fixity_env,
-            export_fixity name_env exports rdr_name
-         ]
+       = fmToList (foldr (perhaps_add_fixity exports) 
+                         emptyFM
+                         (fmToList fixity_env))
+
+    perhaps_add_fixity :: NameSet -> (RdrName, (Fixity, Provenance))
+                      -> FiniteMap OccName (Fixity,Provenance)
+                      -> FiniteMap OccName (Fixity,Provenance)
+    perhaps_add_fixity exports (rdr_name, (fixity, prov)) fix_env
+      =  let
+           do_nothing = fix_env                -- The default is to pass on the env unchanged
+        in
+               -- Step 1: check whether the rdr_name is in scope; if so find its Name
+        case lookupFM name_env rdr_name of {
+          Nothing          -> do_nothing;
+          Just fixity_name -> 
+
+               -- Step 2: check whether the fixity thing is exported
+        if not (fixity_name `elemNameSet` exports) then
+               do_nothing
+        else
+       
+               -- Step 3: check whether we already have a fixity for the
+               -- Name's OccName in the fix_env we are building up.  This can easily
+               -- happen.  the original fixity_env might contain bindings for
+               --      M.a and N.a, if a was imported via M and N.
+               -- If this does happen, we expect the fixity to be the same either way.
+       let
+           occ_name = rdrNameOcc rdr_name
+       in
+       case lookupFM fix_env occ_name of {
+         Just (fixity1, prov1) ->      -- Got it already
+                                  ASSERT( fixity == fixity1 )
+                                  do_nothing;
+         Nothing -> 
+
+               -- Step 3: add it to the outgoing fix_env
+       addToFM fix_env occ_name (fixity,prov)
+       }}
 
 mk_export_fn :: [AvailInfo] -> (Name -> ExportFlag)
 mk_export_fn avails
@@ -439,16 +496,6 @@ mk_export_fn avails
   where
     exported_names :: NameSet
     exported_names = availsToNameSet avails
-
-export_fixity :: NameEnv -> NameSet -> RdrName -> Bool
-export_fixity name_env exports (Unqual _)
-  = False      -- The qualified fixity is always there as well
-export_fixity name_env exports rdr_name@(Qual _ occ)
-  = case lookupFM name_env rdr_name of
-       Just fixity_name -> fixity_name `elemNameSet` exports
-                               -- Check whether the exported thing is
-                               -- the one to which the fixity attaches
-       other   -> False        -- Not even in scope
 \end{code}                               
 
 
@@ -459,24 +506,22 @@ export_fixity name_env exports rdr_name@(Qual _ occ)
 %************************************************************************
 
 \begin{code}
-ieOcc ie = rdrNameOcc (ieName ie)
-
 badImportItemErr mod ie sty
-  = ppSep [ppStr "Module", pprModule sty mod, ppStr "does not export", ppr sty ie]
+  = sep [ptext SLIT("Module"), pprModule sty mod, ptext SLIT("does not export"), ppr sty ie]
 
 modExportErr mod sty
-  = ppCat [ ppStr "Unknown module in export list: module", ppPStr mod]
+  = hsep [ ptext SLIT("Unknown module in export list: module"), ptext mod]
 
 exportItemErr export_item NotAvailable sty
-  = ppSep [ ppStr "Export item not in scope:", ppr sty export_item ]
+  = sep [ ptext SLIT("Export item not in scope:"), ppr sty export_item ]
 
 exportItemErr export_item avail sty
-  = ppHang (ppStr "Export item not fully in scope:")
-          4 (ppAboves [ppCat [ppStr "Wanted:    ", ppr sty export_item],
-                       ppCat [ppStr "Available: ", ppr sty (ieOcc export_item), pprAvail sty avail]])
+  = hang (ptext SLIT("Export item not fully in scope:"))
+          4 (vcat [hsep [ptext SLIT("Wanted:   "), ppr sty export_item],
+                   hsep [ptext SLIT("Available:"), ppr sty (ieOcc export_item), pprAvail sty avail]])
 
 availClashErr (occ_name, ((ie1,avail1), (ie2,avail2))) sty
-  = ppHang (ppCat [ppStr "Conflicting exports for local name: ", ppr sty occ_name])
-       4 (ppAboves [ppr sty ie1, ppr sty ie2])
+  = hsep [ptext SLIT("The export items"), ppr sty ie1, ptext SLIT("and"), ppr sty ie2,
+         ptext SLIT("create conflicting exports for"), ppr sty occ_name]
 \end{code}