ghc/compiler/basicTypes/ProtoName.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
   3 %
   4 \section[ProtoName]{@ProtoName@: name type used early in the compiler}
   5
   6 \begin{code}
   7 #include "HsVersions.h"
   8
   9 module ProtoName (
  10         ProtoName(..),
  11
  12         mkPreludeProtoName,
  13
  14         cmpProtoName, eqProtoName, elemProtoNames,
  15         cmpByLocalName, eqByLocalName, elemByLocalNames,
  16
  17         isConopPN
  18
  19         -- and to make the module self-sufficient...
  20     ) where
  21
  22 import Ubiq{-uitous-}
  23
  24 import Name             ( Name )
  25 import Outputable       ( ifPprShowAll, isConop )
  26 import Pretty
  27 import Util
  28 \end{code}
  29
  30 %************************************************************************
  31 %*                                                                      *
  32 \subsection{The main type declaration}
  33 %*                                                                      *
  34 %************************************************************************
  35
  36 \begin{code}
  37 data ProtoName
  38   = Unk         FAST_STRING     -- local name in module
  39
  40   | Qunk        FAST_STRING     -- qualified name
  41                 FAST_STRING
  42
  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;
  48   | Prel        Name
  49 \end{code}
  50
  51 %************************************************************************
  52 %*                                                                      *
  53 \subsection{Construction}
  54 %*                                                                      *
  55 %************************************************************************
  56
  57 \begin{code}
  58 mkPreludeProtoName :: Name -> ProtoName
  59
  60 mkPreludeProtoName prel_name = Prel prel_name
  61 \end{code}
  62
  63 %************************************************************************
  64 %*                                                                      *
  65 \subsection{Ordering}
  66 %*                                                                      *
  67 %************************************************************************
  68
  69 Comparing @ProtoNames@.  These functions are used to bring together
  70 duplicate declarations for things, and eliminate all but one.
  71
  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@
  78 things.
  79
  80 (Later the same night...: but, oh yes, you do:
  81
  82 Given two instance decls
  83
  84 \begin{verbatim}
  85 instance Eq  {-PreludeCore-}    Foo
  86 instance Bar {-user-defined-}   Foo
  87 \end{verbatim}
  88
  89 you will get a comparison of "Eq" (a Prel) with "Bar" (an {Unk,Imp}))
  90
  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@...)
  95
  96 \begin{code}
  97 cmp_name :: Bool -> ProtoName -> ProtoName -> TAG_
  98
  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
 103      _CMP_STRING_ n1 n2
 104
 105 cmp_name by_local (Prel n1) (Prel n2) = cmp n1 n2
 106
 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...
 109 --
 110 --      Imp H.T , Imp P.I , Unk T
 111 --
 112 -- will *not* be re-ordered to bring the "Imp H.T" and "Unk T" `next to each other'...
 113 --
 114
 115 cmp_name True  (Imp _ _ _ o1) (Imp _ _ _ o2) = _CMP_STRING_ o1 o2
 116
 117 cmp_name False (Imp m1 n1 _ _) (Imp m2 n2 _ _)
 118   = case _CMP_STRING_ n1 n2 of {
 119       LT_ -> LT_;
 120       EQ_ -> case _CMP_STRING_ m1 m2 of {
 121                EQ_ -> EQ_;
 122                xxx -> if _NULL_ m1 || _NULL_ m2
 123                       then EQ_
 124                       else xxx
 125              };
 126       GT__ -> GT_
 127     }
 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.
 134     --
 135     -- We could do this elsewhere in the compiler, but there is
 136     -- an efficiency issue -- we plow through *piles* of instances.
 137
 138 cmp_name True (Imp _ _ _ o1) (Prel nm)
 139   = let
 140         n2 = case (getOrigName nm) of { (_, x) -> x } -- stricter for speed
 141     in
 142     _CMP_STRING_ o1 n2
 143
 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_ }}
 147
 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
 150       LT_  -> GT_
 151       EQ_  -> EQ_
 152       GT__ -> LT_
 153 \end{code}
 154
 155 \begin{code}
 156 eqProtoName, eqByLocalName :: ProtoName -> ProtoName -> Bool
 157
 158 eqProtoName a b
 159   = case cmp_name False a b of { EQ_ -> True; _ -> False }
 160
 161 cmpProtoName a b = cmp_name False a b
 162
 163 eqByLocalName a b
 164   = case cmp_name True  a b of { EQ_ -> True; _ -> False }
 165
 166 cmpByLocalName a b = cmp_name True a b
 167 \end{code}
 168
 169 \begin{code}
 170 elemProtoNames, elemByLocalNames :: ProtoName -> [ProtoName] -> Bool
 171
 172 elemProtoNames _ []     = False
 173 elemProtoNames x (y:ys)
 174   = case cmp_name False x y of
 175       LT_  -> elemProtoNames x ys
 176       EQ_  -> True
 177       GT__ -> elemProtoNames x ys
 178
 179 elemByLocalNames _ []     = False
 180 elemByLocalNames x (y:ys)
 181   = case cmp_name True x y of
 182       LT_  -> elemByLocalNames x ys
 183       EQ_  -> True
 184       GT__ -> elemByLocalNames x ys
 185
 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???
 190 \end{code}
 191
 192 %************************************************************************
 193 %*                                                                      *
 194 \subsection{Instances}
 195 %*                                                                      *
 196 %************************************************************************
 197
 198 \begin{code}
 199 {- THESE INSTANCES ARE TOO DELICATE TO BE USED!
 200 Use eqByLocalName, ...., etc. instead
 201
 202 instance Eq ProtoName where
 203     a == b = case cmp_name False a b of { EQ_ -> True; _ -> False }
 204
 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 }
 208 -}
 209 \end{code}
 210
 211 \begin{code}
 212 instance NamedThing ProtoName where
 213
 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
 218
 219     getOccurrenceName (Unk s)       = s
 220     getOccurrenceName (Qunk _ s)    = s
 221     getOccurrenceName (Imp m s _ o) = o
 222     getOccurrenceName (Prel name)   = getOccurrenceName name
 223
 224 #ifdef DEBUG
 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"
 231 #endif
 232 \end{code}
 233
 234 \begin{code}
 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
 242       where
 243          pp_occur_name s o | s /= o    = ppBesides [ppChar '{', ppPStr o, ppChar '}']
 244                            | otherwise = ppNil
 245 \end{code}