ghc/compiler/rename/RnUtils.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
   3 %
   4 \section[RnUtils]{Functions used by both renaming passes}
   5
   6 \begin{code}
   7 #include "HsVersions.h"
   8
   9 module RnUtils (
  10         mkGlobalNameFun, mkNameFun,
  11         GlobalNameMapper(..),  GlobalNameMappers(..),
  12         PreludeNameMapper(..), PreludeNameMappers(..),
  13
  14         dupNamesErr -- used in various places
  15     ) where
  16
  17 import Ubiq{-uitous-}
  18
  19 import Bag              ( bagToList, Bag )
  20 import FiniteMap        ( lookupFM, listToFM )
  21 import Name             ( Name{-instances-} )
  22 import Outputable       ( pprNonOp )
  23 import PprStyle         ( PprStyle(..) )
  24 import Pretty
  25 import ProtoName        ( ProtoName(..) )
  26 import Util             ( cmpPString, removeDups, pprPanic, panic )
  27 \end{code}
  28
  29 \begin{code}
  30 type GlobalNameMapper  = ProtoName -> Maybe Name
  31 type GlobalNameMappers = (GlobalNameMapper, GlobalNameMapper)
  32
  33 type PreludeNameMapper = FAST_STRING -> Maybe Name
  34 type PreludeNameMappers = (PreludeNameMapper,           -- Values
  35                         PreludeNameMapper               -- Types and classes
  36                        )
  37 \end{code}
  38
  39 \begin{code}
  40 mkGlobalNameFun :: FAST_STRING          -- The module name
  41                 -> PreludeNameMapper    -- The prelude things
  42                 -> [(ProtoName, Name)]  -- The local and imported things
  43                 -> GlobalNameMapper     -- The global name function
  44
  45 mkGlobalNameFun this_module prel_nf alist
  46   = the_fun
  47   where
  48     the_fun (Prel n)      = Just n
  49     the_fun (Unk s)       = case (unk_fun s) of
  50                               Just n  -> Just n
  51                               Nothing -> prel_nf s
  52     the_fun (Imp m d _ _) = imp_fun (d, m) -- NB: module-name 2nd!
  53
  54     -- Things in the domain of the prelude function shouldn't be put
  55     -- in the unk_fun; because the prel_nf will catch them.
  56     -- This can arise if, for example, an interface gives a signature
  57     -- for a prelude thing.
  58     --
  59     -- Neither should they be in the domain of the imp_fun, because
  60     -- prelude things will have been converted to Prel x rather than
  61     -- Imp p q r s.
  62     --
  63     -- So we strip out prelude things from the alist; this is not just
  64     -- desirable, it's essential because get_orig and get_local don't handle
  65     -- prelude things.
  66
  67     non_prel_alist = filter non_prel alist
  68
  69     non_prel (Prel _, _) = False
  70     non_prel other       = True
  71
  72     -- unk_fun looks up local names (just strings),
  73     -- imp_fun looks up original names: (string,string) pairs
  74     unk_fun = lookupFM (listToFM [(get_local pn,n) | (pn,n) <- non_prel_alist])
  75     imp_fun = lookupFM (listToFM [(get_orig  pn,n) | (pn,n) <- non_prel_alist])
  76
  77                 -- the lists *are* sorted by *some* ordering (by local
  78                 -- names), but not generally, and not in some way we
  79                 -- are going to rely on.
  80
  81     get_local :: ProtoName -> FAST_STRING
  82     get_local (Unk s)       = s
  83     get_local (Imp _ _ _ l) = l
  84     get_local (Prel n)      = pprPanic "get_local: " (ppr PprShowAll n)
  85
  86     get_orig :: ProtoName -> (FAST_STRING, FAST_STRING) -- **NB**! module-name 2nd!
  87     get_orig (Unk s)       = (s, this_module)
  88     get_orig (Imp m d _ _) = (d, m)
  89     get_orig (Prel n)       = pprPanic "get_orig: " (ppr PprShowAll n)
  90 \end{code}
  91
  92
  93 @mkNameFun@ builds a function from @ProtoName@s to things, where a
  94 ``thing'' is either a @ProtoName@ (in the case of values), or a
  95 @(ProtoName, ProtoName -> ProtoName)@ pair in the case of types and
  96 classes.  It takes:
  97
  98 \begin{itemize}
  99 \item   The name of the interface
 100 \item   A bag of new string-to-thing bindings to add,
 101
 102 \item   An extractor function, to get a @ProtoName@ out of a thing,
 103         for use in error messages.
 104 \end{itemize}
 105 The function it returns only expects to see @Unk@ things.
 106
 107 @mkNameFun@ checks for clashes in the domain of the new bindings.
 108
 109 ToDo: it should check for clashes with the prelude bindings too.
 110
 111 \begin{code}
 112 mkNameFun :: Bag (FAST_STRING, thing)       -- Value bindings
 113           -> (FAST_STRING -> Maybe thing,   -- The function to use
 114               [[(FAST_STRING,thing)]])      -- Duplicates, if any
 115
 116 mkNameFun the_bag
 117   = case (removeDups cmp (bagToList the_bag)) of { (no_dup_list, dups) ->
 118     case (lookupFM (listToFM no_dup_list))    of { the_fun ->
 119     (the_fun, dups) }}
 120   where
 121     cmp :: (FAST_STRING, a) -> (FAST_STRING, a) -> TAG_
 122
 123     cmp (s1,_) (s2,_) = _CMP_STRING_ s1 s2
 124 \end{code}
 125
 126 \begin{code}
 127 dupNamesErr descriptor ((first_pname,locn1) : dup_things) sty
 128   = ppAboves (first_item : map dup_item dup_things)
 129   where
 130     first_item
 131       = ppBesides [ ppr PprForUser locn1,
 132             ppStr ": multiple declarations of a ", ppStr descriptor, ppStr ": ",
 133             pprNonOp sty first_pname ]
 134
 135     dup_item (pname, locn)
 136       = ppBesides [ ppr PprForUser locn,
 137             ppStr ": here was another declaration of `", pprNonOp sty pname, ppStr "'" ]
 138 \end{code}