X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FbasicTypes%2FUnique.lhs;h=874328863e7b745c79e52abb3e25709ec7fc200d;hb=28a464a75e14cece5db40f2765a29348273ff2d2;hp=3d13ce54465fee964d18dd9b121a3dfc83058499;hpb=861e836ed0cc1aa45932ecb3470967964440a0ef;p=ghc-hetmet.git

diff --git a/ghc/compiler/basicTypes/Unique.lhs b/ghc/compiler/basicTypes/Unique.lhs
index 3d13ce5..8743288 100644
--- a/ghc/compiler/basicTypes/Unique.lhs
+++ b/ghc/compiler/basicTypes/Unique.lhs
@@ -17,19 +17,17 @@ Haskell).
 \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, 
 
@@ -40,20 +38,26 @@ module Unique (
 	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}
 
 %************************************************************************
@@ -69,11 +73,6 @@ Fast comparison is everything on @Uniques@:
 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.
 
@@ -81,9 +80,9 @@ 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
@@ -94,10 +93,12 @@ isTupleKey	:: Unique -> Bool
 
 
 \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#)
 
@@ -119,7 +120,11 @@ i2w_s x = (x::Int#)
 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)
@@ -129,7 +134,11 @@ 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}
 
 
@@ -148,10 +157,13 @@ hasKey		:: Uniquable a => a -> Unique -> Bool
 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}
 
 
@@ -191,15 +203,17 @@ instance Uniquable Unique where
 
 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, ...
@@ -223,48 +237,20 @@ instance Show Unique where
 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}
 
 %************************************************************************
@@ -275,20 +261,34 @@ chars62
 
 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
@@ -308,26 +308,23 @@ isTupleKey u = case unpkUnique u of
 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}