\begin{code}
module Unique (
Unique, Uniquable(..), hasKey,
- u2i, -- hack: used in UniqFM
- pprUnique, pprUnique10,
+ pprUnique,
mkUnique, -- Used in UniqSupply
mkUniqueGrimily, -- Used in UniqSupply only!
- getKey, -- Used in Var only!
+ getKey, getKey#, -- Used in Var, UniqFM, Name only!
incrUnique, -- Used for renumbering
deriveUnique, -- Ditto
newTagUnique, -- Used in CgCase
initTyVarUnique,
- initTidyUniques,
isTupleKey,
mkTupleTyConUnique, mkTupleDataConUnique,
mkPreludeMiscIdUnique, mkPreludeDataConUnique,
mkPreludeTyConUnique, mkPreludeClassUnique,
+ mkPArrDataConUnique,
- getBuiltinUniques, mkBuiltinUnique,
- mkPseudoUnique1, mkPseudoUnique2, mkPseudoUnique3
+ mkBuiltinUnique,
+ mkPseudoUniqueC,
+ mkPseudoUniqueD,
+ mkPseudoUniqueE,
+ mkPseudoUniqueH
) where
#include "HsVersions.h"
import BasicTypes ( Boxity(..) )
+import PackageConfig ( PackageId, packageIdFS )
import FastString ( FastString, uniqueOfFS )
-import GlaExts
-import ST
-import PrelBase ( Char(..), chr, ord )
-
import Outputable
+import FastTypes
+
+import GLAEXTS
+
+import Char ( chr, ord )
\end{code}
%************************************************************************
data Unique = MkUnique Int#
\end{code}
-\begin{code}
-u2i :: Unique -> FAST_INT
-u2i (MkUnique i) = i
-\end{code}
-
Now come the functions which construct uniques from their pieces, and vice versa.
The stuff about unique *supplies* is handled further down this module.
mkUnique :: Char -> Int -> Unique -- Builds a unique from pieces
unpkUnique :: Unique -> (Char, Int) -- The reverse
-mkUniqueGrimily :: Int# -> Unique -- A trap-door for UniqSupply
-
-getKey :: Unique -> Int# -- for Var
+mkUniqueGrimily :: Int -> Unique -- A trap-door for UniqSupply
+getKey :: Unique -> Int -- for Var
+getKey# :: Unique -> Int# -- for Var
incrUnique :: Unique -> Unique
deriveUnique :: Unique -> Int -> Unique
\begin{code}
-mkUniqueGrimily x = MkUnique x
+mkUniqueGrimily (I# x) = MkUnique x
{-# INLINE getKey #-}
-getKey (MkUnique x) = x
+getKey (MkUnique x) = I# x
+{-# INLINE getKey# #-}
+getKey# (MkUnique x) = x
incrUnique (MkUnique i) = MkUnique (i +# 1#)
mkUnique (C# c) (I# i)
= MkUnique (w2i (tag `or#` bits))
where
+#if __GLASGOW_HASKELL__ >= 503
+ tag = i2w (ord# c) `uncheckedShiftL#` i2w_s 24#
+#else
tag = i2w (ord# c) `shiftL#` i2w_s 24#
+#endif
bits = i2w i `and#` (i2w 16777215#){-``0x00ffffff''-}
unpkUnique (MkUnique u)
in
(tag, i)
where
+#if __GLASGOW_HASKELL__ >= 503
+ shiftr x y = uncheckedShiftRL# x y
+#else
shiftr x y = shiftRL# x y
+#endif
\end{code}
x `hasKey` k = getUnique x == k
instance Uniquable FastString where
- getUnique fs = mkUniqueGrimily (uniqueOfFS fs)
+ getUnique fs = mkUniqueGrimily (I# (uniqueOfFS fs))
+
+instance Uniquable PackageId where
+ getUnique pid = getUnique (packageIdFS pid)
instance Uniquable Int where
- getUnique (I# i#) = mkUniqueGrimily i#
+ getUnique i = mkUniqueGrimily i
\end{code}
We do sometimes make strings with @Uniques@ in them:
\begin{code}
-pprUnique, pprUnique10 :: Unique -> SDoc
-
+pprUnique :: Unique -> SDoc
pprUnique uniq
= case unpkUnique uniq of
- (tag, u) -> finish_ppr tag u (iToBase62 u)
+ (tag, u) -> finish_ppr tag u (text (iToBase62 u))
+#ifdef UNUSED
+pprUnique10 :: Unique -> SDoc
pprUnique10 uniq -- in base-10, dudes
= case unpkUnique uniq of
(tag, u) -> finish_ppr tag u (int u)
+#endif
finish_ppr 't' u pp_u | u < 26
= -- Special case to make v common tyvars, t1, t2, ...
A character-stingy way to read/write numbers (notably Uniques).
The ``62-its'' are \tr{[0-9a-zA-Z]}. We don't handle negative Ints.
Code stolen from Lennart.
+
\begin{code}
-# define BYTE_ARRAY GlaExts.ByteArray
-# define RUN_ST ST.runST
-# define AND_THEN >>=
-# define AND_THEN_ >>
-# define RETURN return
-
-iToBase62 :: Int -> SDoc
-
-iToBase62 n@(I# n#)
- = ASSERT(n >= 0)
- let
-#if __GLASGOW_HASKELL__ < 405
- bytes = case chars62 of { BYTE_ARRAY bounds_who_needs_'em bytes -> bytes }
-#else
- bytes = case chars62 of { BYTE_ARRAY _ _ bytes -> bytes }
-#endif
- in
- if n# <# 62# then
- case (indexCharArray# bytes n#) of { c ->
- char (C# c) }
- else
- case (quotRem n 62) of { (q, I# r#) ->
- case (indexCharArray# bytes r#) of { c ->
- (<>) (iToBase62 q) (char (C# c)) }}
-
--- keep this at top level! (bug on 94/10/24 WDP)
-chars62 :: BYTE_ARRAY Int
-chars62
- = RUN_ST (
- newCharArray (0, 61) AND_THEN \ ch_array ->
- fill_in ch_array 0 62 "0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
- AND_THEN_
- unsafeFreezeByteArray ch_array
- )
+iToBase62 :: Int -> String
+iToBase62 n@(I# n#)
+ = ASSERT(n >= 0) go n# ""
where
- fill_in ch_array i lim str
- | i == lim
- = RETURN ()
- | otherwise
- = writeCharArray ch_array i (str !! i) AND_THEN_
- fill_in ch_array (i+1) lim str
+ go n# cs | n# <# 62#
+ = case (indexCharOffAddr# chars62# n#) of { c# -> C# c# : cs }
+ | otherwise
+ = case (quotRem (I# n#) 62) of { (I# q#, I# r#) ->
+ case (indexCharOffAddr# chars62# r#) of { c# ->
+ go q# (C# c# : cs) }}
+
+ chars62# = "0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"#
\end{code}
%************************************************************************
Allocation of unique supply characters:
v,t,u : for renumbering value-, type- and usage- vars.
- other a-z: lower case chars for unique supplies (see Main.lhs)
B: builtin
C-E: pseudo uniques (used in native-code generator)
X: uniques derived by deriveUnique
_: unifiable tyvars (above)
0-9: prelude things below
+ other a-z: lower case chars for unique supplies. Used so far:
+
+ d desugarer
+ f AbsC flattener
+ g SimplStg
+ l ndpFlatten
+ n Native codegen
+ r Hsc name cache
+ s simplifier
+
\begin{code}
mkAlphaTyVarUnique i = mkUnique '1' i
mkPreludeClassUnique i = mkUnique '2' i
-mkPreludeTyConUnique i = mkUnique '3' i
-mkTupleTyConUnique Boxed a = mkUnique '4' a
-mkTupleTyConUnique Unboxed a = mkUnique '5' a
+
+-- Prelude type constructors occupy *three* slots.
+-- The first is for the tycon itself; the latter two
+-- are for the generic to/from Ids. See TysWiredIn.mk_tc_gen_info.
+
+mkPreludeTyConUnique i = mkUnique '3' (3*i)
+mkTupleTyConUnique Boxed a = mkUnique '4' (3*a)
+mkTupleTyConUnique Unboxed a = mkUnique '5' (3*a)
-- Data constructor keys occupy *two* slots. The first is used for the
-- data constructor itself and its wrapper function (the function that
mkPrimOpIdUnique op = mkUnique '9' op
mkPreludeMiscIdUnique i = mkUnique '0' i
+-- No numbers left anymore, so I pick something different for the character
+-- tag
+mkPArrDataConUnique a = mkUnique ':' (2*a)
+
-- The "tyvar uniques" print specially nicely: a, b, c, etc.
-- See pprUnique for details
initTyVarUnique :: Unique
initTyVarUnique = mkUnique 't' 0
-initTidyUniques :: (Unique, Unique) -- Global and local
-initTidyUniques = (mkUnique 'g' 0, mkUnique 'x' 0)
-
-mkPseudoUnique1, mkPseudoUnique2, mkPseudoUnique3,
+mkPseudoUniqueC, mkPseudoUniqueD, mkPseudoUniqueE, mkPseudoUniqueH,
mkBuiltinUnique :: Int -> Unique
mkBuiltinUnique i = mkUnique 'B' i
-mkPseudoUnique1 i = mkUnique 'C' i -- used for getUnique on Regs
-mkPseudoUnique2 i = mkUnique 'D' i -- used in NCG for getUnique on RealRegs
-mkPseudoUnique3 i = mkUnique 'E' i -- used in NCG spiller to create spill VirtualRegs
-
-
-
-getBuiltinUniques :: Int -> [Unique]
-getBuiltinUniques n = map (mkUnique 'B') [1 .. n]
+mkPseudoUniqueC i = mkUnique 'C' i -- used for getUnique on Regs
+mkPseudoUniqueD i = mkUnique 'D' i -- used in NCG for getUnique on RealRegs
+mkPseudoUniqueE i = mkUnique 'E' i -- used in NCG spiller to create spill VirtualRegs
+mkPseudoUniqueH i = mkUnique 'H' i -- used in NCG spiller to create spill VirtualRegs
\end{code}
projects / ghc-hetmet.git / blobdiff