ghc/compiler/rename/RenameAuxFuns.lhs

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