[project @ 1996-03-19 08:58:34 by partain]

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

diff --git a/ghc/compiler/rename/RenameAuxFuns.lhs b/ghc/compiler/rename/RnUtils.lhs
similarity index 66%
rename from ghc/compiler/rename/RenameAuxFuns.lhs
rename to ghc/compiler/rename/RnUtils.lhs
index 68106c1..1d4e45b 100644 (file)
--- a/ghc/compiler/rename/RenameAuxFuns.lhs
+++ b/ghc/compiler/rename/RnUtils.lhs
@@ -1,48 +1,46 @@
 %
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1995
+% (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
 %
-\section[Rename-aux-funs]{Functions used by both renaming passes}
+\section[RnUtils]{Functions used by both renaming passes}
 
 \begin{code}
 #include "HsVersions.h"
 
-module RenameAuxFuns (
+module RnUtils (
        mkGlobalNameFun, mkNameFun,
-       GlobalNameFun(..),  GlobalNameFuns(..),
-       PreludeNameFun(..), PreludeNameFuns(..),
+       GlobalNameMapper(..),  GlobalNameMappers(..),
+       PreludeNameMapper(..), PreludeNameMappers(..),
 
-       -- and for self-containedness...
-       Bag, ProtoName, Maybe
+       dupNamesErr -- used in various places
     ) where
 
-IMPORT_Trace           -- ToDo: rm (for debugging)
-import Outputable
-import Pretty
+import Ubiq{-uitous-}
 
-import Bag             ( Bag, bagToList )
-import FiniteMap
-import Maybes
-import Name            ( Name ) -- for instances
---OLD: import NameEnv
-import ProtoName
-import Util
+import Bag             ( bagToList, Bag )
+import FiniteMap       ( lookupFM, listToFM )
+import Name            ( Name{-instances-} )
+import Outputable      ( pprNonOp )
+import PprStyle                ( PprStyle(..) )
+import Pretty
+import ProtoName       ( ProtoName(..) )
+import Util            ( cmpPString, removeDups, pprPanic, panic )
 \end{code}
 
 \begin{code}
-type GlobalNameFun  = ProtoName -> Maybe Name
-type GlobalNameFuns = (GlobalNameFun, GlobalNameFun)
+type GlobalNameMapper  = ProtoName -> Maybe Name
+type GlobalNameMappers = (GlobalNameMapper, GlobalNameMapper)
 
-type PreludeNameFun = FAST_STRING -> Maybe Name
-type PreludeNameFuns = (PreludeNameFun,                -- Values
-                       PreludeNameFun          -- Types and classes
+type PreludeNameMapper = FAST_STRING -> Maybe Name
+type PreludeNameMappers = (PreludeNameMapper,          -- Values
+                       PreludeNameMapper               -- Types and classes
                       )
 \end{code}
 
 \begin{code}
 mkGlobalNameFun :: FAST_STRING         -- The module name
-               -> PreludeNameFun       -- The prelude things
-               -> [(ProtoName, Name)]  -- The local and imported things
-               -> GlobalNameFun        -- The global name function
+               -> PreludeNameMapper    -- The prelude things
+               -> [(ProtoName, Name)]  -- The local and imported things
+               -> GlobalNameMapper     -- The global name function
 
 mkGlobalNameFun this_module prel_nf alist
   = the_fun
@@ -59,7 +57,7 @@ mkGlobalNameFun this_module prel_nf alist
     -- for a prelude thing.
     --
     -- Neither should they be in the domain of the imp_fun, because
-    -- prelude things will have been converted to Prel x rather than 
+    -- prelude things will have been converted to Prel x rather than
     -- Imp p q r s.
     --
     -- So we strip out prelude things from the alist; this is not just
@@ -76,10 +74,6 @@ mkGlobalNameFun this_module prel_nf alist
     unk_fun = lookupFM (listToFM [(get_local pn,n) | (pn,n) <- non_prel_alist])
     imp_fun = lookupFM (listToFM [(get_orig  pn,n) | (pn,n) <- non_prel_alist])
 
-{- OLD:
-    unk_fun = mkStringLookupFn  [(get_local pn,n) | (pn,n) <- non_prel_alist] False{-not sorted-}
-    imp_fun = mk2StringLookupFn [(get_orig  pn,n) | (pn,n) <- non_prel_alist] False{-not sorted-}
--}
                -- the lists *are* sorted by *some* ordering (by local
                -- names), but not generally, and not in some way we
                -- are going to rely on.
@@ -121,12 +115,24 @@ mkNameFun :: Bag (FAST_STRING, thing)         -- Value bindings
 
 mkNameFun the_bag
   = case (removeDups cmp (bagToList the_bag)) of { (no_dup_list, dups) ->
-    case (lookupFM (listToFM no_dup_list))    of { the_fun -> 
-    --OLD :case (mkStringLookupFn no_dup_list True{-list is pre-sorted-}) of the_fun -> 
-    (the_fun, dups)
-    }}
+    case (lookupFM (listToFM no_dup_list))    of { the_fun ->
+    (the_fun, dups) }}
   where
     cmp :: (FAST_STRING, a) -> (FAST_STRING, a) -> TAG_
 
     cmp (s1,_) (s2,_) = _CMP_STRING_ s1 s2
 \end{code}
+
+\begin{code}
+dupNamesErr descriptor ((first_pname,locn1) : dup_things) sty
+  = ppAboves (first_item : map dup_item dup_things)
+  where
+    first_item
+      = ppBesides [ ppr PprForUser locn1,
+           ppStr ": multiple declarations of a ", ppStr descriptor, ppStr ": ",
+           pprNonOp sty first_pname ]
+
+    dup_item (pname, locn)
+      = ppBesides [ ppr PprForUser locn,
+           ppStr ": here was another declaration of `", pprNonOp sty pname, ppStr "'" ]
+\end{code}