2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
4 \section[ProtoName]{@ProtoName@: name type used early in the compiler}
7 #include "HsVersions.h"
14 cmpProtoName, eqProtoName, elemProtoNames,
15 cmpByLocalName, eqByLocalName, elemByLocalNames,
19 -- and to make the module self-sufficient...
25 import Outputable ( ifPprShowAll, isConop )
30 %************************************************************************
32 \subsection{The main type declaration}
34 %************************************************************************
38 = Unk FAST_STRING -- local name in module
40 | Qunk FAST_STRING -- qualified name
43 | Imp FAST_STRING -- name of defining module
44 FAST_STRING -- name used in defining name
45 [FAST_STRING] -- name of the module whose interfaces
46 -- told me about this thing
47 FAST_STRING -- occurrence name;
51 %************************************************************************
53 \subsection{Construction}
55 %************************************************************************
58 mkPreludeProtoName :: Name -> ProtoName
60 mkPreludeProtoName prel_name = Prel prel_name
63 %************************************************************************
67 %************************************************************************
69 Comparing @ProtoNames@. These functions are used to bring together
70 duplicate declarations for things, and eliminate all but one.
72 In general, the things thus manipulated are not prelude things, but we
73 still need to be able to compare prelude classes and type constructors
74 so that we can compare instance declarations. However, since all
75 Prelude classes and type constructors come from @PreludeCore@, and
76 hence can't not be in scope, they will always be of the form (@Prel@
77 n), so we don't need to compare @Prel@ things against @Imp@ or @Unk@
80 (Later the same night...: but, oh yes, you do:
82 Given two instance decls
85 instance Eq {-PreludeCore-} Foo
86 instance Bar {-user-defined-} Foo
89 you will get a comparison of "Eq" (a Prel) with "Bar" (an {Unk,Imp}))
91 @cmp_name@ compares either by ``local name'' (the string by which
92 the entity is known in this module) or by original
93 name, in which case the module name is also taken into account.
94 (Just watch what happens on @Imps@...)
97 cmp_name :: Bool -> ProtoName -> ProtoName -> TAG_
99 cmp_name by_local (Unk n1) (Unk n2) = _CMP_STRING_ n1 n2
100 cmp_name by_local (Unk n1) (Imp m n2 _ o2) = _CMP_STRING_ n1 (if by_local then o2 else n2)
101 cmp_name by_local (Unk n1) (Prel nm)
102 = let (_, n2) = getOrigName nm in
105 cmp_name by_local (Prel n1) (Prel n2) = cmp n1 n2
107 -- in ordering these things, it's *most* important to have "names" (vs "modules")
108 -- as the primary comparison key; otherwise, a list of ProtoNames like...
110 -- Imp H.T , Imp P.I , Unk T
112 -- will *not* be re-ordered to bring the "Imp H.T" and "Unk T" `next to each other'...
115 cmp_name True (Imp _ _ _ o1) (Imp _ _ _ o2) = _CMP_STRING_ o1 o2
117 cmp_name False (Imp m1 n1 _ _) (Imp m2 n2 _ _)
118 = case _CMP_STRING_ n1 n2 of {
120 EQ_ -> case _CMP_STRING_ m1 m2 of {
122 xxx -> if _NULL_ m1 || _NULL_ m2
128 -- That's a real **HACK** on comparing "original module" names!
129 -- The thing is: we `make up' ProtoNames for instances for
130 -- sorting-out-interfaces purposes, but we *may* not know the
131 -- original module, so it will be Nil. This is the *ONLY* way
132 -- that a "" `module name' can arise! Rather than say "not equal",
133 -- we want that Nil to compare as a `wildcard', matching anything.
135 -- We could do this elsewhere in the compiler, but there is
136 -- an efficiency issue -- we plow through *piles* of instances.
138 cmp_name True (Imp _ _ _ o1) (Prel nm)
140 n2 = case (getOrigName nm) of { (_, x) -> x } -- stricter for speed
144 cmp_name False (Imp m1 n1 _ _) (Prel nm)
145 = case getOrigName nm of { (m2, n2) ->
146 case _CMP_STRING_ n1 n2 of { LT_ -> LT_; EQ_ -> _CMP_STRING_ m1 m2; GT__ -> GT_ }}
148 cmp_name by_local other_p1 other_p2
149 = case cmp_name by_local other_p2 other_p1 of -- compare the other way around
156 eqProtoName, eqByLocalName :: ProtoName -> ProtoName -> Bool
159 = case cmp_name False a b of { EQ_ -> True; _ -> False }
161 cmpProtoName a b = cmp_name False a b
164 = case cmp_name True a b of { EQ_ -> True; _ -> False }
166 cmpByLocalName a b = cmp_name True a b
170 elemProtoNames, elemByLocalNames :: ProtoName -> [ProtoName] -> Bool
172 elemProtoNames _ [] = False
173 elemProtoNames x (y:ys)
174 = case cmp_name False x y of
175 LT_ -> elemProtoNames x ys
177 GT__ -> elemProtoNames x ys
179 elemByLocalNames _ [] = False
180 elemByLocalNames x (y:ys)
181 = case cmp_name True x y of
182 LT_ -> elemByLocalNames x ys
184 GT__ -> elemByLocalNames x ys
186 isConopPN :: ProtoName -> Bool
187 isConopPN (Unk s) = isConop s
188 isConopPN (Qunk _ s) = isConop s
189 isConopPN (Imp _ n _ _) = isConop n -- ToDo: should use occurrence name???
192 %************************************************************************
194 \subsection{Instances}
196 %************************************************************************
199 {- THESE INSTANCES ARE TOO DELICATE TO BE USED!
200 Use eqByLocalName, ...., etc. instead
202 instance Eq ProtoName where
203 a == b = case cmp_name False a b of { EQ_ -> True; _ -> False }
205 instance Ord ProtoName where
206 a < b = case cmp_name False a b of { LT_ -> True; EQ_ -> False; GT__ -> False }
207 a <= b = case cmp_name False a b of { LT_ -> True; EQ_ -> True; GT__ -> False }
212 instance NamedThing ProtoName where
214 getOrigName (Unk _) = panic "NamedThing.ProtoName.getOrigName (Unk)"
215 getOrigName (Qunk _ _) = panic "NamedThing.ProtoName.getOrigName (Qunk)"
216 getOrigName (Imp m s _ _) = (m, s)
217 getOrigName (Prel name) = getOrigName name
219 getOccurrenceName (Unk s) = s
220 getOccurrenceName (Qunk _ s) = s
221 getOccurrenceName (Imp m s _ o) = o
222 getOccurrenceName (Prel name) = getOccurrenceName name
225 getSrcLoc pn = panic "NamedThing.ProtoName.getSrcLoc"
226 getInformingModules pn = panic "NamedThing.ProtoName.getInformingModule"
227 getItsUnique pn = panic "NamedThing.ProtoName.getItsUnique"
228 fromPreludeCore pn = panic "NamedThing.ProtoName.fromPreludeCore"
229 getExportFlag pn = panic "NamedThing.ProtoName.getExportFlag"
230 isLocallyDefined pn = panic "NamedThing.ProtoName.isLocallyDefined"
235 instance Outputable ProtoName where
236 ppr sty (Unk s) = ppPStr s
237 ppr sty (Qunk m s) = ppBesides [ppPStr m, ppChar '.', ppPStr s]
238 ppr sty (Prel name) = ppBeside (ppr sty name) (ifPprShowAll sty (ppPStr SLIT("/PREL")))
239 ppr sty (Imp mod dec imod loc)
240 = ppBesides [ppPStr mod, ppChar '.', ppPStr dec, pp_occur_name dec loc ]
241 -- ToDo: print "informant modules" if high debugging level
243 pp_occur_name s o | s /= o = ppBesides [ppChar '{', ppPStr o, ppChar '}']