2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1995
4 \section[Rename-aux-funs]{Functions used by both renaming passes}
7 #include "HsVersions.h"
10 mkGlobalNameFun, mkNameFun,
11 GlobalNameFun(..), GlobalNameFuns(..),
12 PreludeNameFun(..), PreludeNameFuns(..),
14 -- and for self-containedness...
18 IMPORT_Trace -- ToDo: rm (for debugging)
22 import Bag ( Bag, bagToList )
25 import Name ( Name ) -- for instances
32 type GlobalNameFun = ProtoName -> Maybe Name
33 type GlobalNameFuns = (GlobalNameFun, GlobalNameFun)
35 type PreludeNameFun = FAST_STRING -> Maybe Name
36 type PreludeNameFuns = (PreludeNameFun, -- Values
37 PreludeNameFun -- Types and classes
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
47 mkGlobalNameFun this_module prel_nf alist
50 the_fun (Prel n) = Just n
51 the_fun (Unk s) = case (unk_fun s) of
54 the_fun (Imp m d _ _) = imp_fun (d, m) -- NB: module-name 2nd!
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.
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
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
69 non_prel_alist = filter non_prel alist
71 non_prel (Prel _, _) = False
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])
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-}
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.
87 get_local :: ProtoName -> FAST_STRING
89 get_local (Imp _ _ _ l) = l
90 get_local (Prel n) = pprPanic "get_local: " (ppr PprShowAll n)
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)
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
105 \item The name of the interface
106 \item A bag of new string-to-thing bindings to add,
108 \item An extractor function, to get a @ProtoName@ out of a thing,
109 for use in error messages.
111 The function it returns only expects to see @Unk@ things.
113 @mkNameFun@ checks for clashes in the domain of the new bindings.
115 ToDo: it should check for clashes with the prelude bindings too.
118 mkNameFun :: Bag (FAST_STRING, thing) -- Value bindings
119 -> (FAST_STRING -> Maybe thing, -- The function to use
120 [[(FAST_STRING,thing)]]) -- Duplicates, if any
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 ->
129 cmp :: (FAST_STRING, a) -> (FAST_STRING, a) -> TAG_
131 cmp (s1,_) (s2,_) = _CMP_STRING_ s1 s2