ghc/compiler/basicTypes/ProtoName.lhs

   1 %************************************************************************
   2 %*                                                                      *
   3 \section[ProtoName]{@ProtoName@: name type used early in the compiler}
   4 %*                                                                      *
   5 %************************************************************************
   6
   7 \begin{code}
   8 #include "HsVersions.h"
   9
  10 module ProtoName (
  11         ProtoName(..),
  12
  13         mkPreludeProtoName,
  14
  15         cmpProtoName, eqProtoName, elemProtoNames,
  16         cmpByLocalName, eqByLocalName, elemByLocalNames,
  17
  18         isConopPN,
  19
  20         -- and to make the module self-sufficient...
  21         Name, Maybe
  22 #ifndef __GLASGOW_HASKELL__
  23         ,TAG_
  24 #endif
  25     ) where
  26
  27 IMPORT_Trace            -- ToDo: rm (debugging)
  28
  29 import Name             ( cmpName, Name
  30                           IF_ATTACK_PRAGMAS(COMMA eqName)
  31                         )
  32 import Outputable
  33 import Pretty
  34 import Util
  35 \end{code}
  36
  37 %************************************************************************
  38 %*                                                                      *
  39 \subsection{The main type declaration}
  40 %*                                                                      *
  41 %************************************************************************
  42
  43 \begin{code}
  44 data ProtoName
  45   = Unk         FAST_STRING     -- local name in module
  46
  47   | Imp         FAST_STRING     -- name of defining module
  48                 FAST_STRING     -- name used in defining name
  49                 [FAST_STRING]   -- name of the module whose interfaces
  50                                 -- told me about this thing
  51                 FAST_STRING     -- occurrence name; Nothing => same as field 2
  52   | Prel        Name
  53 {- LATER:
  54   | Unk2        FAST_INT        -- same as Unk but this FAST_INT is
  55                                 -- the index into hash table (makes for
  56                                 -- superbly great equality comparisons!)
  57                 FAST_STRING
  58 -}
  59 \end{code}
  60
  61 %************************************************************************
  62 %*                                                                      *
  63 \subsection{Construction}
  64 %*                                                                      *
  65 %************************************************************************
  66
  67 \begin{code}
  68 mkPreludeProtoName :: Name -> ProtoName
  69
  70 mkPreludeProtoName prel_name = Prel prel_name
  71 \end{code}
  72
  73 %************************************************************************
  74 %*                                                                      *
  75 \subsection{Ordering}
  76 %*                                                                      *
  77 %************************************************************************
  78
  79 Comparing @ProtoNames@.  These functions are used to bring together
  80 duplicate declarations for things, and eliminate all but one.
  81
  82 In general, the things thus manipulated are not prelude things, but we
  83 still need to be able to compare prelude classes and type constructors
  84 so that we can compare instance declarations.  However, since all
  85 Prelude classes and type constructors come from @PreludeCore@, and
  86 hence can't not be in scope, they will always be of the form (@Prel@
  87 n), so we don't need to compare @Prel@ things against @Imp@ or @Unk@
  88 things.
  89
  90 (Later the same night...: but, oh yes, you do:
  91
  92 Given two instance decls
  93
  94 \begin{verbatim}
  95 instance Eq  {-PreludeCore-}    Foo
  96 instance Bar {-user-defined-}   Foo
  97 \end{verbatim}
  98
  99 you will get a comparison of "Eq" (a Prel) with "Bar" (an {Unk,Imp}))
 100
 101 @cmp_name@ compares either by ``local name'' (the string by which
 102 the entity is known in this module, renaming and all) or by original
 103 name, in which case the module name is also taken into account.
 104 (Just watch what happens on @Imps@...)
 105
 106 \begin{code}
 107 cmp_name :: Bool -> ProtoName -> ProtoName -> TAG_
 108
 109 cmp_name by_local (Unk n1) (Unk n2)        = _CMP_STRING_ n1 n2
 110 cmp_name by_local (Unk n1) (Imp m n2 _ o2) = _CMP_STRING_ n1 (if by_local then o2 else n2)
 111 cmp_name by_local (Unk n1) (Prel nm)
 112   =  let  (_, n2) = getOrigName nm  in
 113      _CMP_STRING_ n1 n2
 114
 115 cmp_name by_local (Prel n1) (Prel n2) = cmpName n1 n2
 116
 117 -- in ordering these things, it's *most* important to have "names" (vs "modules")
 118 -- as the primary comparison key; otherwise, a list of ProtoNames like...
 119 --
 120 --      Imp H.T , Imp P.I , Unk T
 121 --
 122 -- will *not* be re-ordered to bring the "Imp H.T" and "Unk T" `next to each other'...
 123 --
 124
 125 cmp_name True  (Imp _ _ _ o1) (Imp _ _ _ o2) = _CMP_STRING_ o1 o2
 126
 127 cmp_name False (Imp m1 n1 _ _) (Imp m2 n2 _ _)
 128   = case _CMP_STRING_ n1 n2 of {
 129       LT_ -> LT_;
 130       EQ_ -> case _CMP_STRING_ m1 m2 of {
 131                EQ_ -> EQ_;
 132                xxx -> if _NULL_ m1 || _NULL_ m2
 133                       then EQ_
 134                       else xxx
 135              };
 136       GT__ -> GT_
 137     }
 138     -- That's a real **HACK** on comparing "original module" names!
 139     -- The thing is: we `make up' ProtoNames for instances for
 140     -- sorting-out-interfaces purposes, but we *may* not know the
 141     -- original module, so it will be Nil.  This is the *ONLY* way
 142     -- that a "" `module name' can arise!  Rather than say "not equal",
 143     -- we want that Nil to compare as a `wildcard', matching anything.
 144     --
 145     -- We could do this elsewhere in the compiler, but there is
 146     -- an efficiency issue -- we plow through *piles* of instances.
 147
 148 cmp_name True (Imp _ _ _ o1) (Prel nm)
 149   = let
 150         n2 = case (getOrigName nm) of { (_, x) -> x } -- stricter for speed
 151     in
 152     _CMP_STRING_ o1 n2
 153
 154 cmp_name False (Imp m1 n1 _ _) (Prel nm)
 155   = case getOrigName nm   of { (m2, n2) ->
 156     case _CMP_STRING_ n1 n2 of { LT_ -> LT_; EQ_ -> _CMP_STRING_ m1 m2; GT__ -> GT_ }}
 157
 158 cmp_name by_local other_p1 other_p2
 159   = case cmp_name by_local other_p2 other_p1 of -- compare the other way around
 160       LT_  -> GT_
 161       EQ_  -> EQ_
 162       GT__ -> LT_
 163 \end{code}
 164
 165 \begin{code}
 166 eqProtoName, eqByLocalName :: ProtoName -> ProtoName -> Bool
 167
 168 eqProtoName a b
 169   = case cmp_name False a b of { EQ_ -> True; _ -> False }
 170
 171 cmpProtoName a b = cmp_name False a b
 172
 173 eqByLocalName a b
 174   = case cmp_name True  a b of { EQ_ -> True; _ -> False }
 175
 176 cmpByLocalName a b = cmp_name True a b
 177 \end{code}
 178
 179 \begin{code}
 180 elemProtoNames, elemByLocalNames :: ProtoName -> [ProtoName] -> Bool
 181
 182 elemProtoNames _ []     = False
 183 elemProtoNames x (y:ys)
 184   = case cmp_name False x y of
 185       LT_  -> elemProtoNames x ys
 186       EQ_  -> True
 187       GT__ -> elemProtoNames x ys
 188
 189 elemByLocalNames _ []     = False
 190 elemByLocalNames x (y:ys)
 191   = case cmp_name True x y of
 192       LT_  -> elemByLocalNames x ys
 193       EQ_  -> True
 194       GT__ -> elemByLocalNames x ys
 195
 196 isConopPN :: ProtoName -> Bool
 197 isConopPN (Unk s)       = isConop s
 198 isConopPN (Imp _ n _ _) = isConop n -- ToDo: should use occurrence name???
 199 \end{code}
 200
 201 %************************************************************************
 202 %*                                                                      *
 203 \subsection{Instances}
 204 %*                                                                      *
 205 %************************************************************************
 206
 207 ********** REMOVE THESE WHEN WE FIX THE SET-ery IN RenameBinds4 *********
 208
 209 \begin{code}
 210 {- THESE INSTANCES ARE TOO DELICATE TO BE USED!
 211 Use eqByLocalName, ...., etc. instead
 212
 213 instance Eq ProtoName where
 214     a == b = case cmp_name False a b of { EQ_ -> True; _ -> False }
 215
 216 instance Ord ProtoName where
 217     a <  b = case cmp_name False a b of { LT_ -> True; EQ_ -> False; GT__ -> False }
 218     a <= b = case cmp_name False a b of { LT_ -> True; EQ_ -> True;  GT__ -> False }
 219 -}
 220 \end{code}
 221
 222 \begin{code}
 223 instance NamedThing ProtoName where
 224
 225     getOrigName (Unk _)         = panic "NamedThing.ProtoName.getOrigName (Unk)"
 226     getOrigName (Imp m s _ _)   = (m, s)
 227     getOrigName (Prel name)     = getOrigName name
 228
 229     getOccurrenceName (Unk s)       = s
 230     getOccurrenceName (Imp m s _ o) = o
 231     getOccurrenceName (Prel name)   = getOccurrenceName name
 232
 233     hasType pn                  = False
 234
 235 #ifdef DEBUG
 236     getSrcLoc pn                = panic "NamedThing.ProtoName.getSrcLoc"
 237     getInformingModules pn      = panic "NamedThing.ProtoName.getInformingModule"
 238     getTheUnique pn             = panic "NamedThing.ProtoName.getUnique"
 239     fromPreludeCore pn          = panic "NamedThing.ProtoName.fromPreludeCore"
 240     getExportFlag pn            = panic "NamedThing.ProtoName.getExportFlag"
 241     isLocallyDefined pn         = panic "NamedThing.ProtoName.isLocallyDefined"
 242     getType pn                  = panic "NamedThing.ProtoName.getType"
 243 #endif
 244 \end{code}
 245
 246 \begin{code}
 247 instance Outputable ProtoName where
 248     ppr sty (Unk s)     = ppPStr s
 249     ppr sty (Prel name) = ppBeside (ppr sty name) (ifPprShowAll sty (ppPStr SLIT("/PREL")))
 250     ppr sty (Imp mod dec imod loc)
 251       = ppBesides [ppPStr mod, ppChar '.', ppPStr dec, pp_occur_name dec loc ]
 252         -- ToDo: print "informant modules" if high debugging level
 253       where
 254          pp_occur_name s o | s /= o    = ppBesides [ppChar '{', ppPStr o, ppChar '}']
 255                            | otherwise = ppNil
 256 \end{code}