Make the constraint solver use UniqFMs (ultimately Data.IntMap)
[ghc.git] / compiler / basicTypes / Unique.lhs
1 %
2 % (c) The University of Glasgow 2006
3 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 %
5
6 @Uniques@ are used to distinguish entities in the compiler (@Ids@,
7 @Classes@, etc.) from each other.  Thus, @Uniques@ are the basic
8 comparison key in the compiler.
9
10 If there is any single operation that needs to be fast, it is @Unique@
11 comparison.  Unsurprisingly, there is quite a bit of huff-and-puff
12 directed to that end.
13
14 Some of the other hair in this code is to be able to use a
15 ``splittable @UniqueSupply@'' if requested/possible (not standard
16 Haskell).
17
18 \begin{code}
19 {-# LANGUAGE BangPatterns #-}
20 module Unique (
21         -- * Main data types
22         Unique, Uniquable(..), 
23         
24         -- ** Constructors, desctructors and operations on 'Unique's
25         hasKey,
26
27         pprUnique, 
28
29         mkUniqueGrimily,                -- Used in UniqSupply only!
30         getKey, getKeyFastInt,          -- Used in Var, UniqFM, Name only!
31
32         incrUnique,                     -- Used for renumbering
33         deriveUnique,                   -- Ditto
34         newTagUnique,                   -- Used in CgCase
35         initTyVarUnique,
36
37         isTupleKey, 
38
39         -- ** Making built-in uniques
40
41         -- now all the built-in Uniques (and functions to make them)
42         -- [the Oh-So-Wonderful Haskell module system wins again...]
43         mkAlphaTyVarUnique,
44         mkPrimOpIdUnique,
45         mkTupleTyConUnique, mkTupleDataConUnique,
46         mkPreludeMiscIdUnique, mkPreludeDataConUnique,
47         mkPreludeTyConUnique, mkPreludeClassUnique,
48         mkPArrDataConUnique,
49
50         mkVarOccUnique, mkDataOccUnique, mkTvOccUnique, mkTcOccUnique,
51         mkRegSingleUnique, mkRegPairUnique, mkRegClassUnique, mkRegSubUnique,
52
53         mkBuiltinUnique,
54         mkPseudoUniqueC,
55         mkPseudoUniqueD,
56         mkPseudoUniqueE,
57         mkPseudoUniqueH
58     ) where
59
60 #include "HsVersions.h"
61
62 import BasicTypes
63 import FastTypes
64 import FastString
65 import Outputable
66 -- import StaticFlags
67
68 #if defined(__GLASGOW_HASKELL__)
69 --just for implementing a fast [0,61) -> Char function
70 import GHC.Exts (indexCharOffAddr#, Char(..))
71 #else
72 import Data.Array
73 #endif
74 import Data.Char        ( chr, ord )
75 \end{code}
76
77 %************************************************************************
78 %*                                                                      *
79 \subsection[Unique-type]{@Unique@ type and operations}
80 %*                                                                      *
81 %************************************************************************
82
83 The @Chars@ are ``tag letters'' that identify the @UniqueSupply@.
84 Fast comparison is everything on @Uniques@:
85
86 \begin{code}
87 --why not newtype Int?
88
89 -- | The type of unique identifiers that are used in many places in GHC
90 -- for fast ordering and equality tests. You should generate these with
91 -- the functions from the 'UniqSupply' module
92 data Unique = MkUnique FastInt
93 \end{code}
94
95 Now come the functions which construct uniques from their pieces, and vice versa.
96 The stuff about unique *supplies* is handled further down this module.
97
98 \begin{code}
99 unpkUnique      :: Unique -> (Char, Int)        -- The reverse
100
101 mkUniqueGrimily :: Int -> Unique                -- A trap-door for UniqSupply
102 getKey          :: Unique -> Int                -- for Var
103 getKeyFastInt   :: Unique -> FastInt            -- for Var
104
105 incrUnique      :: Unique -> Unique
106 deriveUnique    :: Unique -> Int -> Unique
107 newTagUnique    :: Unique -> Char -> Unique
108
109 isTupleKey      :: Unique -> Bool
110 \end{code}
111
112
113 \begin{code}
114 mkUniqueGrimily x = MkUnique (iUnbox x)
115
116 {-# INLINE getKey #-}
117 getKey (MkUnique x) = iBox x
118 {-# INLINE getKeyFastInt #-}
119 getKeyFastInt (MkUnique x) = x
120
121 incrUnique (MkUnique i) = MkUnique (i +# _ILIT(1))
122
123 -- deriveUnique uses an 'X' tag so that it won't clash with
124 -- any of the uniques produced any other way
125 deriveUnique (MkUnique i) delta = mkUnique 'X' (iBox i + delta)
126
127 -- newTagUnique changes the "domain" of a unique to a different char
128 newTagUnique u c = mkUnique c i where (_,i) = unpkUnique u
129
130 -- pop the Char in the top 8 bits of the Unique(Supply)
131
132 -- No 64-bit bugs here, as long as we have at least 32 bits. --JSM
133
134 -- and as long as the Char fits in 8 bits, which we assume anyway!
135
136 mkUnique :: Char -> Int -> Unique       -- Builds a unique from pieces
137 -- NOT EXPORTED, so that we can see all the Chars that 
138 --               are used in this one module
139 mkUnique c i
140   = MkUnique (tag `bitOrFastInt` bits)
141   where
142     !tag  = fastOrd (cUnbox c) `shiftLFastInt` _ILIT(24)
143     !bits = iUnbox i `bitAndFastInt` _ILIT(16777215){-``0x00ffffff''-}
144
145 unpkUnique (MkUnique u)
146   = let
147         -- as long as the Char may have its eighth bit set, we
148         -- really do need the logical right-shift here!
149         tag = cBox (fastChr (u `shiftRLFastInt` _ILIT(24)))
150         i   = iBox (u `bitAndFastInt` _ILIT(16777215){-``0x00ffffff''-})
151     in
152     (tag, i)
153 \end{code}
154
155
156
157 %************************************************************************
158 %*                                                                      *
159 \subsection[Uniquable-class]{The @Uniquable@ class}
160 %*                                                                      *
161 %************************************************************************
162
163 \begin{code}
164 -- | Class of things that we can obtain a 'Unique' from
165 class Uniquable a where
166     getUnique :: a -> Unique
167
168 hasKey          :: Uniquable a => a -> Unique -> Bool
169 x `hasKey` k    = getUnique x == k
170
171 instance Uniquable FastString where
172  getUnique fs = mkUniqueGrimily (iBox (uniqueOfFS fs))
173
174 instance Uniquable Int where
175  getUnique i = mkUniqueGrimily i
176
177 instance Uniquable n => Uniquable (IPName n) where
178   getUnique (IPName n) = getUnique n
179 \end{code}
180
181
182 %************************************************************************
183 %*                                                                      *
184 \subsection[Unique-instances]{Instance declarations for @Unique@}
185 %*                                                                      *
186 %************************************************************************
187
188 And the whole point (besides uniqueness) is fast equality.  We don't
189 use `deriving' because we want {\em precise} control of ordering
190 (equality on @Uniques@ is v common).
191
192 \begin{code}
193 eqUnique, ltUnique, leUnique :: Unique -> Unique -> Bool
194 eqUnique (MkUnique u1) (MkUnique u2) = u1 ==# u2
195 ltUnique (MkUnique u1) (MkUnique u2) = u1 <#  u2
196 leUnique (MkUnique u1) (MkUnique u2) = u1 <=# u2
197
198 cmpUnique :: Unique -> Unique -> Ordering
199 cmpUnique (MkUnique u1) (MkUnique u2)
200   = if u1 ==# u2 then EQ else if u1 <# u2 then LT else GT
201
202 instance Eq Unique where
203     a == b = eqUnique a b
204     a /= b = not (eqUnique a b)
205
206 instance Ord Unique where
207     a  < b = ltUnique a b
208     a <= b = leUnique a b
209     a  > b = not (leUnique a b)
210     a >= b = not (ltUnique a b)
211     compare a b = cmpUnique a b
212
213 -----------------
214 instance Uniquable Unique where
215     getUnique u = u
216 \end{code}
217
218 We do sometimes make strings with @Uniques@ in them:
219 \begin{code}
220 pprUnique :: Unique -> SDoc
221 pprUnique uniq
222 --   | opt_SuppressUniques
223 --  = empty     -- Used exclusively to suppress uniques so you 
224 --  | otherwise -- can compare output easily
225   = case unpkUnique uniq of
226       (tag, u) -> finish_ppr tag u (text (iToBase62 u))
227
228 #ifdef UNUSED
229 pprUnique10 :: Unique -> SDoc
230 pprUnique10 uniq        -- in base-10, dudes
231   = case unpkUnique uniq of
232       (tag, u) -> finish_ppr tag u (int u)
233 #endif
234
235 finish_ppr :: Char -> Int -> SDoc -> SDoc
236 finish_ppr 't' u _pp_u | u < 26
237   =     -- Special case to make v common tyvars, t1, t2, ...
238         -- come out as a, b, ... (shorter, easier to read)
239     char (chr (ord 'a' + u))
240 finish_ppr tag _ pp_u = char tag <> pp_u
241
242 instance Outputable Unique where
243     ppr u = pprUnique u
244
245 instance Show Unique where
246     showsPrec p uniq = showsPrecSDoc p (pprUnique uniq)
247 \end{code}
248
249 %************************************************************************
250 %*                                                                      *
251 \subsection[Utils-base62]{Base-62 numbers}
252 %*                                                                      *
253 %************************************************************************
254
255 A character-stingy way to read/write numbers (notably Uniques).
256 The ``62-its'' are \tr{[0-9a-zA-Z]}.  We don't handle negative Ints.
257 Code stolen from Lennart.
258
259 \begin{code}
260 iToBase62 :: Int -> String
261 iToBase62 n_
262   = ASSERT(n_ >= 0) go (iUnbox n_) ""
263   where
264     go n cs | n <# _ILIT(62)
265              = case chooseChar62 n of { c -> c `seq` (c : cs) }
266              | otherwise
267              =  case (quotRem (iBox n) 62) of { (q_, r_) ->
268                 case iUnbox q_ of { q -> case iUnbox r_ of { r ->
269                 case (chooseChar62 r) of { c -> c `seq`
270                 (go q (c : cs)) }}}}
271
272     chooseChar62 :: FastInt -> Char
273     {-# INLINE chooseChar62 #-}
274 #if defined(__GLASGOW_HASKELL__)
275     --then FastInt == Int#
276     chooseChar62 n = C# (indexCharOffAddr# chars62 n)
277     !chars62 = "0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"#
278 #else
279     --Haskell98 arrays are portable
280     chooseChar62 n = (!) chars62 n
281     chars62 = listArray (0,61) "0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
282 #endif
283 \end{code}
284
285 %************************************************************************
286 %*                                                                      *
287 \subsection[Uniques-prelude]{@Uniques@ for wired-in Prelude things}
288 %*                                                                      *
289 %************************************************************************
290
291 Allocation of unique supply characters:
292         v,t,u : for renumbering value-, type- and usage- vars.
293         B:   builtin
294         C-E: pseudo uniques     (used in native-code generator)
295         X:   uniques derived by deriveUnique
296         _:   unifiable tyvars   (above)
297         0-9: prelude things below
298              (no numbers left any more..)
299         ::   (prelude) parallel array data constructors
300
301         other a-z: lower case chars for unique supplies.  Used so far:
302
303         d       desugarer
304         f       AbsC flattener
305         g       SimplStg
306         n       Native codegen
307         r       Hsc name cache
308         s       simplifier
309
310 \begin{code}
311 mkAlphaTyVarUnique     :: Int -> Unique
312 mkPreludeClassUnique   :: Int -> Unique
313 mkPreludeTyConUnique   :: Int -> Unique
314 mkTupleTyConUnique     :: Boxity -> Int -> Unique
315 mkPreludeDataConUnique :: Int -> Unique
316 mkTupleDataConUnique   :: Boxity -> Int -> Unique
317 mkPrimOpIdUnique       :: Int -> Unique
318 mkPreludeMiscIdUnique  :: Int -> Unique
319 mkPArrDataConUnique    :: Int -> Unique
320
321 mkAlphaTyVarUnique i            = mkUnique '1' i
322
323 mkPreludeClassUnique i          = mkUnique '2' i
324
325 -- Prelude type constructors occupy *three* slots.
326 -- The first is for the tycon itself; the latter two
327 -- are for the generic to/from Ids.  See TysWiredIn.mk_tc_gen_info.
328
329 mkPreludeTyConUnique i          = mkUnique '3' (3*i)
330 mkTupleTyConUnique Boxed   a    = mkUnique '4' (3*a)
331 mkTupleTyConUnique Unboxed a    = mkUnique '5' (3*a)
332
333 -- Data constructor keys occupy *two* slots.  The first is used for the
334 -- data constructor itself and its wrapper function (the function that
335 -- evaluates arguments as necessary and calls the worker). The second is
336 -- used for the worker function (the function that builds the constructor
337 -- representation).
338
339 mkPreludeDataConUnique i        = mkUnique '6' (2*i)    -- Must be alphabetic
340 mkTupleDataConUnique Boxed a    = mkUnique '7' (2*a)    -- ditto (*may* be used in C labels)
341 mkTupleDataConUnique Unboxed a  = mkUnique '8' (2*a)
342
343 -- This one is used for a tiresome reason
344 -- to improve a consistency-checking error check in the renamer
345 isTupleKey u = case unpkUnique u of
346                 (tag,_) -> tag == '4' || tag == '5' || tag == '7' || tag == '8'
347
348 mkPrimOpIdUnique op         = mkUnique '9' op
349 mkPreludeMiscIdUnique  i    = mkUnique '0' i
350
351 -- No numbers left anymore, so I pick something different for the character tag 
352 mkPArrDataConUnique a           = mkUnique ':' (2*a)
353
354 -- The "tyvar uniques" print specially nicely: a, b, c, etc.
355 -- See pprUnique for details
356
357 initTyVarUnique :: Unique
358 initTyVarUnique = mkUnique 't' 0
359
360 mkPseudoUniqueC, mkPseudoUniqueD, mkPseudoUniqueE, mkPseudoUniqueH,
361    mkBuiltinUnique :: Int -> Unique
362
363 mkBuiltinUnique i = mkUnique 'B' i
364 mkPseudoUniqueC i = mkUnique 'C' i -- used for getUnique on Regs
365 mkPseudoUniqueD i = mkUnique 'D' i -- used in NCG for getUnique on RealRegs
366 mkPseudoUniqueE i = mkUnique 'E' i -- used in NCG spiller to create spill VirtualRegs
367 mkPseudoUniqueH i = mkUnique 'H' i -- used in NCG spiller to create spill VirtualRegs
368
369 mkRegSingleUnique, mkRegPairUnique, mkRegSubUnique, mkRegClassUnique :: Int -> Unique
370 mkRegSingleUnique = mkUnique 'R'
371 mkRegSubUnique    = mkUnique 'S'
372 mkRegPairUnique   = mkUnique 'P'
373 mkRegClassUnique  = mkUnique 'L'
374
375 mkVarOccUnique, mkDataOccUnique, mkTvOccUnique, mkTcOccUnique :: FastString -> Unique
376 -- See Note [The Unique of an OccName] in OccName
377 mkVarOccUnique  fs = mkUnique 'i' (iBox (uniqueOfFS fs))
378 mkDataOccUnique fs = mkUnique 'd' (iBox (uniqueOfFS fs))
379 mkTvOccUnique   fs = mkUnique 'v' (iBox (uniqueOfFS fs))
380 mkTcOccUnique   fs = mkUnique 'c' (iBox (uniqueOfFS fs))
381 \end{code}
382