TickBox representation change
[ghc-hetmet.git] / compiler / basicTypes / Name.lhs
1 %
2 % (c) The University of Glasgow 2006
3 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 %
5 \section[Name]{@Name@: to transmit name info from renamer to typechecker}
6
7 \begin{code}
8 module Name (
9         -- Re-export the OccName stuff
10         module OccName,
11
12         -- The Name type
13         Name,                                   -- Abstract
14         BuiltInSyntax(..), 
15         mkInternalName, mkSystemName,
16         mkSystemVarName, mkSysTvName, 
17         mkFCallName, mkIPName,
18         mkTickBoxOpName,
19         mkExternalName, mkWiredInName,
20
21         nameUnique, setNameUnique,
22         nameOccName, nameModule, nameModule_maybe,
23         tidyNameOcc, 
24         hashName, localiseName,
25
26         nameSrcLoc,
27
28         isSystemName, isInternalName, isExternalName,
29         isTyVarName, isTyConName, isWiredInName, isBuiltInSyntax,
30         wiredInNameTyThing_maybe, 
31         nameIsLocalOrFrom,
32         
33         -- Class NamedThing and overloaded friends
34         NamedThing(..),
35         getSrcLoc, getOccString
36     ) where
37
38 #include "HsVersions.h"
39
40 import {-# SOURCE #-} TypeRep( TyThing )
41
42 import OccName
43 import Module
44 import SrcLoc
45 import UniqFM
46 import Unique
47 import Maybes
48 import Binary
49 import FastMutInt
50 import FastString
51 import Outputable
52
53 import Data.IORef
54 import GHC.Exts
55 import Data.Array
56 \end{code}
57
58 %************************************************************************
59 %*                                                                      *
60 \subsection[Name-datatype]{The @Name@ datatype, and name construction}
61 %*                                                                      *
62 %************************************************************************
63  
64 \begin{code}
65 data Name = Name {
66                 n_sort :: NameSort,     -- What sort of name it is
67                 n_occ  :: !OccName,     -- Its occurrence name
68                 n_uniq :: Int#,         -- UNPACK doesn't work, recursive type
69                 n_loc  :: !SrcLoc       -- Definition site
70             }
71
72 -- NOTE: we make the n_loc field strict to eliminate some potential
73 -- (and real!) space leaks, due to the fact that we don't look at
74 -- the SrcLoc in a Name all that often.
75
76 data NameSort
77   = External Module
78  
79   | WiredIn Module TyThing BuiltInSyntax
80         -- A variant of External, for wired-in things
81
82   | Internal            -- A user-defined Id or TyVar
83                         -- defined in the module being compiled
84
85   | System              -- A system-defined Id or TyVar.  Typically the
86                         -- OccName is very uninformative (like 's')
87
88 data BuiltInSyntax = BuiltInSyntax | UserSyntax
89 -- BuiltInSyntax is for things like (:), [], tuples etc, 
90 -- which have special syntactic forms.  They aren't "in scope"
91 -- as such.
92 \end{code}
93
94 Notes about the NameSorts:
95
96 1.  Initially, top-level Ids (including locally-defined ones) get External names, 
97     and all other local Ids get Internal names
98
99 2.  Things with a External name are given C static labels, so they finally
100     appear in the .o file's symbol table.  They appear in the symbol table
101     in the form M.n.  If originally-local things have this property they
102     must be made @External@ first.
103
104 3.  In the tidy-core phase, a External that is not visible to an importer
105     is changed to Internal, and a Internal that is visible is changed to External
106
107 4.  A System Name differs in the following ways:
108         a) has unique attached when printing dumps
109         b) unifier eliminates sys tyvars in favour of user provs where possible
110
111     Before anything gets printed in interface files or output code, it's
112     fed through a 'tidy' processor, which zaps the OccNames to have
113     unique names; and converts all sys-locals to user locals
114     If any desugarer sys-locals have survived that far, they get changed to
115     "ds1", "ds2", etc.
116
117 Built-in syntax => It's a syntactic form, not "in scope" (e.g. [])
118
119 Wired-in thing  => The thing (Id, TyCon) is fully known to the compiler, 
120                    not read from an interface file. 
121                    E.g. Bool, True, Int, Float, and many others
122
123 All built-in syntax is for wired-in things.
124
125 \begin{code}
126 nameUnique              :: Name -> Unique
127 nameOccName             :: Name -> OccName 
128 nameModule              :: Name -> Module
129 nameSrcLoc              :: Name -> SrcLoc
130
131 nameUnique  name = mkUniqueGrimily (I# (n_uniq name))
132 nameOccName name = n_occ  name
133 nameSrcLoc  name = n_loc  name
134 \end{code}
135
136 \begin{code}
137 nameIsLocalOrFrom :: Module -> Name -> Bool
138 isInternalName    :: Name -> Bool
139 isExternalName    :: Name -> Bool
140 isSystemName      :: Name -> Bool
141 isWiredInName     :: Name -> Bool
142
143 isWiredInName (Name {n_sort = WiredIn _ _ _}) = True
144 isWiredInName other                           = False
145
146 wiredInNameTyThing_maybe :: Name -> Maybe TyThing
147 wiredInNameTyThing_maybe (Name {n_sort = WiredIn _ thing _}) = Just thing
148 wiredInNameTyThing_maybe other                               = Nothing
149
150 isBuiltInSyntax (Name {n_sort = WiredIn _ _ BuiltInSyntax}) = True
151 isBuiltInSyntax other                                       = False
152
153 isExternalName (Name {n_sort = External _})    = True
154 isExternalName (Name {n_sort = WiredIn _ _ _}) = True
155 isExternalName other                           = False
156
157 isInternalName name = not (isExternalName name)
158
159 nameModule name = nameModule_maybe name `orElse` pprPanic "nameModule" (ppr name)
160 nameModule_maybe (Name { n_sort = External mod})    = Just mod
161 nameModule_maybe (Name { n_sort = WiredIn mod _ _}) = Just mod
162 nameModule_maybe name                               = Nothing
163
164 nameIsLocalOrFrom from name
165   | isExternalName name = from == nameModule name
166   | otherwise           = True
167
168 isTyVarName :: Name -> Bool
169 isTyVarName name = isTvOcc (nameOccName name)
170
171 isTyConName :: Name -> Bool
172 isTyConName name = isTcOcc (nameOccName name)
173
174 isSystemName (Name {n_sort = System}) = True
175 isSystemName other                    = False
176 \end{code}
177
178
179 %************************************************************************
180 %*                                                                      *
181 \subsection{Making names}
182 %*                                                                      *
183 %************************************************************************
184
185 \begin{code}
186 mkInternalName :: Unique -> OccName -> SrcLoc -> Name
187 mkInternalName uniq occ loc = Name { n_uniq = getKey# uniq, n_sort = Internal, n_occ = occ, n_loc = loc }
188         -- NB: You might worry that after lots of huffing and
189         -- puffing we might end up with two local names with distinct
190         -- uniques, but the same OccName.  Indeed we can, but that's ok
191         --      * the insides of the compiler don't care: they use the Unique
192         --      * when printing for -ddump-xxx you can switch on -dppr-debug to get the
193         --        uniques if you get confused
194         --      * for interface files we tidyCore first, which puts the uniques
195         --        into the print name (see setNameVisibility below)
196
197 mkExternalName :: Unique -> Module -> OccName -> SrcLoc -> Name
198 mkExternalName uniq mod occ loc 
199   = Name { n_uniq = getKey# uniq, n_sort = External mod,
200            n_occ = occ, n_loc = loc }
201
202 mkWiredInName :: Module -> OccName -> Unique -> TyThing -> BuiltInSyntax
203         -> Name
204 mkWiredInName mod occ uniq thing built_in
205   = Name { n_uniq = getKey# uniq,
206            n_sort = WiredIn mod thing built_in,
207            n_occ = occ, n_loc = wiredInSrcLoc }
208
209 mkSystemName :: Unique -> OccName -> Name
210 mkSystemName uniq occ = Name { n_uniq = getKey# uniq, n_sort = System, 
211                                n_occ = occ, n_loc = noSrcLoc }
212
213 mkSystemVarName :: Unique -> FastString -> Name
214 mkSystemVarName uniq fs = mkSystemName uniq (mkVarOccFS fs)
215
216 mkSysTvName :: Unique -> FastString -> Name
217 mkSysTvName uniq fs = mkSystemName uniq (mkOccNameFS tvName fs) 
218
219 mkFCallName :: Unique -> String -> Name
220         -- The encoded string completely describes the ccall
221 mkFCallName uniq str =  Name { n_uniq = getKey# uniq, n_sort = Internal, 
222                                n_occ = mkVarOcc str, n_loc = noSrcLoc }
223
224 mkTickBoxOpName :: Unique -> String -> Name
225 mkTickBoxOpName uniq str 
226    = Name { n_uniq = getKey# uniq, n_sort = Internal, 
227             n_occ = mkVarOcc str, n_loc = noSrcLoc }
228
229 mkIPName :: Unique -> OccName -> Name
230 mkIPName uniq occ
231   = Name { n_uniq = getKey# uniq,
232            n_sort = Internal,
233            n_occ  = occ,
234            n_loc = noSrcLoc }
235 \end{code}
236
237 \begin{code}
238 -- When we renumber/rename things, we need to be
239 -- able to change a Name's Unique to match the cached
240 -- one in the thing it's the name of.  If you know what I mean.
241 setNameUnique :: Name -> Unique -> Name
242 setNameUnique name uniq = name {n_uniq = getKey# uniq}
243
244 tidyNameOcc :: Name -> OccName -> Name
245 -- We set the OccName of a Name when tidying
246 -- In doing so, we change System --> Internal, so that when we print
247 -- it we don't get the unique by default.  It's tidy now!
248 tidyNameOcc name@(Name { n_sort = System }) occ = name { n_occ = occ, n_sort = Internal}
249 tidyNameOcc name                            occ = name { n_occ = occ }
250
251 localiseName :: Name -> Name
252 localiseName n = n { n_sort = Internal }
253 \end{code}
254
255
256 %************************************************************************
257 %*                                                                      *
258 \subsection{Predicates and selectors}
259 %*                                                                      *
260 %************************************************************************
261
262 \begin{code}
263 hashName :: Name -> Int
264 hashName name = getKey (nameUnique name)
265 \end{code}
266
267
268 %************************************************************************
269 %*                                                                      *
270 \subsection[Name-instances]{Instance declarations}
271 %*                                                                      *
272 %************************************************************************
273
274 \begin{code}
275 cmpName n1 n2 = I# (n_uniq n1) `compare` I# (n_uniq n2)
276 \end{code}
277
278 \begin{code}
279 instance Eq Name where
280     a == b = case (a `compare` b) of { EQ -> True;  _ -> False }
281     a /= b = case (a `compare` b) of { EQ -> False; _ -> True }
282
283 instance Ord Name where
284     a <= b = case (a `compare` b) of { LT -> True;  EQ -> True;  GT -> False }
285     a <  b = case (a `compare` b) of { LT -> True;  EQ -> False; GT -> False }
286     a >= b = case (a `compare` b) of { LT -> False; EQ -> True;  GT -> True  }
287     a >  b = case (a `compare` b) of { LT -> False; EQ -> False; GT -> True  }
288     compare a b = cmpName a b
289
290 instance Uniquable Name where
291     getUnique = nameUnique
292
293 instance NamedThing Name where
294     getName n = n
295 \end{code}
296
297 %************************************************************************
298 %*                                                                      *
299 \subsection{Binary}
300 %*                                                                      *
301 %************************************************************************
302
303 \begin{code}
304 instance Binary Name where
305    put_ bh name = do
306       case getUserData bh of { 
307         UserData { ud_symtab_map = symtab_map_ref,
308                    ud_symtab_next = symtab_next } -> do
309          symtab_map <- readIORef symtab_map_ref
310          case lookupUFM symtab_map name of
311            Just (off,_) -> put_ bh off
312            Nothing -> do
313               off <- readFastMutInt symtab_next
314               writeFastMutInt symtab_next (off+1)
315               writeIORef symtab_map_ref
316                   $! addToUFM symtab_map name (off,name)
317               put_ bh off          
318      }
319
320    get bh = do
321         i <- get bh
322         return $! (ud_symtab (getUserData bh) ! i)
323 \end{code}
324
325 %************************************************************************
326 %*                                                                      *
327 \subsection{Pretty printing}
328 %*                                                                      *
329 %************************************************************************
330
331 \begin{code}
332 instance Outputable Name where
333     ppr name = pprName name
334
335 instance OutputableBndr Name where
336     pprBndr _ name = pprName name
337
338 pprName name@(Name {n_sort = sort, n_uniq = u#, n_occ = occ})
339   = getPprStyle $ \ sty ->
340     case sort of
341       WiredIn mod _ builtin   -> pprExternal sty uniq mod occ True  builtin
342       External mod            -> pprExternal sty uniq mod occ False UserSyntax
343       System                  -> pprSystem sty uniq occ
344       Internal                -> pprInternal sty uniq occ
345   where uniq = mkUniqueGrimily (I# u#)
346
347 pprExternal sty uniq mod occ is_wired is_builtin
348   | codeStyle sty        = ppr mod <> char '_' <> ppr_z_occ_name occ
349         -- In code style, always qualify
350         -- ToDo: maybe we could print all wired-in things unqualified
351         --       in code style, to reduce symbol table bloat?
352  | debugStyle sty       = ppr mod <> dot <> ppr_occ_name occ
353                 <> braces (hsep [if is_wired then ptext SLIT("(w)") else empty,
354                                  pprNameSpaceBrief (occNameSpace occ), 
355                                  pprUnique uniq])
356   | BuiltInSyntax <- is_builtin  = ppr_occ_name occ
357         -- never qualify builtin syntax
358   | Just mod <- qualName sty mod occ = ppr mod <> dot <> ppr_occ_name occ
359         -- the PrintUnqualified tells us how to qualify this Name, if at all
360   | otherwise                     = ppr_occ_name occ
361
362 pprInternal sty uniq occ
363   | codeStyle sty  = pprUnique uniq
364   | debugStyle sty = ppr_occ_name occ <> braces (hsep [pprNameSpaceBrief (occNameSpace occ), 
365                                                        pprUnique uniq])
366   | dumpStyle sty  = ppr_occ_name occ <> char '_' <> pprUnique uniq
367                         -- For debug dumps, we're not necessarily dumping
368                         -- tidied code, so we need to print the uniques.
369   | otherwise      = ppr_occ_name occ   -- User style
370
371 -- Like Internal, except that we only omit the unique in Iface style
372 pprSystem sty uniq occ
373   | codeStyle sty  = pprUnique uniq
374   | debugStyle sty = ppr_occ_name occ <> char '_' <> pprUnique uniq
375                      <> braces (pprNameSpaceBrief (occNameSpace occ))
376   | otherwise      = ppr_occ_name occ <> char '_' <> pprUnique uniq
377                                 -- If the tidy phase hasn't run, the OccName
378                                 -- is unlikely to be informative (like 's'),
379                                 -- so print the unique
380
381 ppr_occ_name occ = ftext (occNameFS occ)
382         -- Don't use pprOccName; instead, just print the string of the OccName; 
383         -- we print the namespace in the debug stuff above
384
385 -- In code style, we Z-encode the strings.  The results of Z-encoding each FastString are
386 -- cached behind the scenes in the FastString implementation.
387 ppr_z_occ_name occ = ftext (zEncodeFS (occNameFS occ))
388 \end{code}
389
390 %************************************************************************
391 %*                                                                      *
392 \subsection{Overloaded functions related to Names}
393 %*                                                                      *
394 %************************************************************************
395
396 \begin{code}
397 class NamedThing a where
398     getOccName :: a -> OccName
399     getName    :: a -> Name
400
401     getOccName n = nameOccName (getName n)      -- Default method
402 \end{code}
403
404 \begin{code}
405 getSrcLoc           :: NamedThing a => a -> SrcLoc
406 getOccString        :: NamedThing a => a -> String
407
408 getSrcLoc           = nameSrcLoc           . getName
409 getOccString        = occNameString        . getOccName
410 \end{code}
411