X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FbasicTypes%2FUnique.lhs;h=41806040d26f36750a8fc9bc1a9ad53745ccd269;hp=5f9f66834f3a5ff311b397f15face7018331ea43;hb=5289f5d85610f71625a439747a09384876655eb5;hpb=9226af9eef1cc45dd745ce21ddeb36a0be0da708

diff --git a/compiler/basicTypes/Unique.lhs b/compiler/basicTypes/Unique.lhs
index 5f9f668..4180604 100644
--- a/compiler/basicTypes/Unique.lhs
+++ b/compiler/basicTypes/Unique.lhs
@@ -16,21 +16,18 @@ Some of the other hair in this code is to be able to use a
 Haskell).
 
 \begin{code}
-{-# OPTIONS -w #-}
--- The above warning supression flag is a temporary kludge.
--- While working on this module you are encouraged to remove it and fix
--- any warnings in the module. See
---     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
--- for details
-
+{-# LANGUAGE BangPatterns #-}
 module Unique (
-	Unique, Uniquable(..), hasKey,
+        -- * Main data types
+	Unique, Uniquable(..), 
+	
+	-- ** Constructors, desctructors and operations on 'Unique's
+	hasKey,
 
 	pprUnique, 
 
-	mkUnique,			-- Used in UniqSupply
 	mkUniqueGrimily,		-- Used in UniqSupply only!
-	getKey, getKey#,		-- Used in Var, UniqFM, Name only!
+	getKey, getKeyFastInt,		-- Used in Var, UniqFM, Name only!
 
 	incrUnique,			-- Used for renumbering
 	deriveUnique,			-- Ditto
@@ -39,6 +36,8 @@ module Unique (
 
 	isTupleKey, 
 
+        -- ** Making built-in uniques
+
 	-- now all the built-in Uniques (and functions to make them)
 	-- [the Oh-So-Wonderful Haskell module system wins again...]
 	mkAlphaTyVarUnique,
@@ -48,6 +47,9 @@ module Unique (
 	mkPreludeTyConUnique, mkPreludeClassUnique,
 	mkPArrDataConUnique,
 
+        mkVarOccUnique, mkDataOccUnique, mkTvOccUnique, mkTcOccUnique,
+        mkRegSingleUnique, mkRegPairUnique, mkRegClassUnique, mkRegSubUnique,
+
 	mkBuiltinUnique,
 	mkPseudoUniqueC,
 	mkPseudoUniqueD,
@@ -57,12 +59,18 @@ module Unique (
 
 #include "HsVersions.h"
 
-import StaticFlags
 import BasicTypes
+import FastTypes
 import FastString
 import Outputable
+-- import StaticFlags
 
-import GHC.Exts
+#if defined(__GLASGOW_HASKELL__)
+--just for implementing a fast [0,61) -> Char function
+import GHC.Exts (indexCharOffAddr#, Char(..))
+#else
+import Data.Array
+#endif
 import Data.Char	( chr, ord )
 \end{code}
 
@@ -76,19 +84,23 @@ The @Chars@ are ``tag letters'' that identify the @UniqueSupply@.
 Fast comparison is everything on @Uniques@:
 
 \begin{code}
-data Unique = MkUnique Int#
+--why not newtype Int?
+
+-- | The type of unique identifiers that are used in many places in GHC
+-- for fast ordering and equality tests. You should generate these with
+-- the functions from the 'UniqSupply' module
+data Unique = MkUnique FastInt
 \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.
 
 \begin{code}
-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
-getKey#		:: Unique -> Int#		-- for Var
+getKeyFastInt	:: Unique -> FastInt		-- for Var
 
 incrUnique	:: Unique -> Unique
 deriveUnique	:: Unique -> Int -> Unique
@@ -99,18 +111,18 @@ isTupleKey	:: Unique -> Bool
 
 
 \begin{code}
-mkUniqueGrimily (I# x) = MkUnique x
+mkUniqueGrimily x = MkUnique (iUnbox x)
 
 {-# INLINE getKey #-}
-getKey (MkUnique x) = I# x
-{-# INLINE getKey# #-}
-getKey# (MkUnique x) = x
+getKey (MkUnique x) = iBox x
+{-# INLINE getKeyFastInt #-}
+getKeyFastInt (MkUnique x) = x
 
-incrUnique (MkUnique i) = MkUnique (i +# 1#)
+incrUnique (MkUnique i) = MkUnique (i +# _ILIT(1))
 
 -- deriveUnique uses an 'X' tag so that it won't clash with
 -- any of the uniques produced any other way
-deriveUnique (MkUnique i) delta = mkUnique 'X' (I# i + delta)
+deriveUnique (MkUnique i) delta = mkUnique 'X' (iBox i + delta)
 
 -- newTagUnique changes the "domain" of a unique to a different char
 newTagUnique u c = mkUnique c i where (_,i) = unpkUnique u
@@ -119,20 +131,23 @@ newTagUnique u c = mkUnique c i where (_,i) = unpkUnique u
 
 -- No 64-bit bugs here, as long as we have at least 32 bits. --JSM
 
-w2i x = word2Int# x
-i2w x = int2Word# x
-i2w_s x = (x::Int#)
+-- and as long as the Char fits in 8 bits, which we assume anyway!
 
-mkUnique (C# c) (I# i)
-  = MkUnique (w2i (tag `or#` bits))
+mkUnique :: Char -> Int -> Unique	-- Builds a unique from pieces
+-- NOT EXPORTED, so that we can see all the Chars that 
+--               are used in this one module
+mkUnique c i
+  = MkUnique (tag `bitOrFastInt` bits)
   where
-    tag  = i2w (ord# c) `uncheckedShiftL#` i2w_s 24#
-    bits = i2w i `and#` (i2w 16777215#){-``0x00ffffff''-}
+    !tag  = fastOrd (cUnbox c) `shiftLFastInt` _ILIT(24)
+    !bits = iUnbox i `bitAndFastInt` _ILIT(16777215){-``0x00ffffff''-}
 
 unpkUnique (MkUnique u)
   = let
-	tag = C# (chr# (w2i ((i2w u) `uncheckedShiftRL#` (i2w_s 24#))))
-	i   = I# (w2i ((i2w u) `and#` (i2w 16777215#){-``0x00ffffff''-}))
+	-- as long as the Char may have its eighth bit set, we
+	-- really do need the logical right-shift here!
+	tag = cBox (fastChr (u `shiftRLFastInt` _ILIT(24)))
+	i   = iBox (u `bitAndFastInt` _ILIT(16777215){-``0x00ffffff''-})
     in
     (tag, i)
 \end{code}
@@ -146,6 +161,7 @@ unpkUnique (MkUnique u)
 %************************************************************************
 
 \begin{code}
+-- | Class of things that we can obtain a 'Unique' from
 class Uniquable a where
     getUnique :: a -> Unique
 
@@ -153,7 +169,7 @@ hasKey		:: Uniquable a => a -> Unique -> Bool
 x `hasKey` k	= getUnique x == k
 
 instance Uniquable FastString where
- getUnique fs = mkUniqueGrimily (I# (uniqueOfFS fs))
+ getUnique fs = mkUniqueGrimily (iBox (uniqueOfFS fs))
 
 instance Uniquable Int where
  getUnique i = mkUniqueGrimily i
@@ -171,10 +187,12 @@ use `deriving' because we want {\em precise} control of ordering
 (equality on @Uniques@ is v common).
 
 \begin{code}
+eqUnique, ltUnique, leUnique :: Unique -> Unique -> Bool
 eqUnique (MkUnique u1) (MkUnique u2) = u1 ==# u2
 ltUnique (MkUnique u1) (MkUnique u2) = u1 <#  u2
 leUnique (MkUnique u1) (MkUnique u2) = u1 <=# u2
 
+cmpUnique :: Unique -> Unique -> Ordering
 cmpUnique (MkUnique u1) (MkUnique u2)
   = if u1 ==# u2 then EQ else if u1 <# u2 then LT else GT
 
@@ -198,11 +216,9 @@ We do sometimes make strings with @Uniques@ in them:
 \begin{code}
 pprUnique :: Unique -> SDoc
 pprUnique uniq
-#ifdef DEBUG
-  | opt_SuppressUniques
-  = empty	-- Used exclusively to suppress uniques so you 
-  | otherwise	-- can compare output easily
-#endif
+--   | opt_SuppressUniques
+--  = empty	-- Used exclusively to suppress uniques so you 
+--  | otherwise	-- can compare output easily
   = case unpkUnique uniq of
       (tag, u) -> finish_ppr tag u (text (iToBase62 u))
 
@@ -213,11 +229,12 @@ pprUnique10 uniq	-- in base-10, dudes
       (tag, u) -> finish_ppr tag u (int u)
 #endif
 
-finish_ppr 't' u pp_u | u < 26
+finish_ppr :: Char -> Int -> SDoc -> SDoc
+finish_ppr 't' u _pp_u | u < 26
   =	-- Special case to make v common tyvars, t1, t2, ...
 	-- come out as a, b, ... (shorter, easier to read)
     char (chr (ord 'a' + u))
-finish_ppr tag u pp_u = char tag <> pp_u
+finish_ppr tag _ pp_u = char tag <> pp_u
 
 instance Outputable Unique where
     ppr u = pprUnique u
@@ -238,17 +255,28 @@ Code stolen from Lennart.
 
 \begin{code}
 iToBase62 :: Int -> String
-iToBase62 n@(I# n#) 
-  = ASSERT(n >= 0) go n# ""
+iToBase62 n_
+  = ASSERT(n_ >= 0) go (iUnbox n_) ""
   where
-    go n# cs | n# <# 62# 
-	     = case (indexCharOffAddr# chars62# n#) of { c# -> C# c# : cs }
+    go n cs | n <# _ILIT(62)
+	     = case chooseChar62 n of { c -> c `seq` (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"#
+	     =	case (quotRem (iBox n) 62) of { (q_, r_) ->
+                case iUnbox q_ of { q -> case iUnbox r_ of { r ->
+		case (chooseChar62 r) of { c -> c `seq`
+		(go q (c : cs)) }}}}
+
+    chooseChar62 :: FastInt -> Char
+    {-# INLINE chooseChar62 #-}
+#if defined(__GLASGOW_HASKELL__)
+    --then FastInt == Int#
+    chooseChar62 n = C# (indexCharOffAddr# chars62 n)
+    !chars62 = "0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"#
+#else
+    --Haskell98 arrays are portable
+    chooseChar62 n = (!) chars62 n
+    chars62 = listArray (0,61) "0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
+#endif
 \end{code}
 
 %************************************************************************
@@ -264,21 +292,32 @@ Allocation of unique supply characters:
 	X:   uniques derived by deriveUnique
 	_:   unifiable tyvars   (above)
 	0-9: prelude things below
+	     (no numbers left any more..)
+	::   (prelude) parallel array data constructors
 
 	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     :: Int -> Unique
+mkPreludeClassUnique   :: Int -> Unique
+mkPreludeTyConUnique   :: Int -> Unique
+mkTupleTyConUnique     :: Boxity -> Int -> Unique
+mkPreludeDataConUnique :: Int -> Unique
+mkTupleDataConUnique   :: Boxity -> Int -> Unique
+mkPrimOpIdUnique       :: Int -> Unique
+mkPreludeMiscIdUnique  :: Int -> Unique
+mkPArrDataConUnique    :: Int -> Unique
+
 mkAlphaTyVarUnique i            = mkUnique '1' i
 
-mkPreludeClassUnique i		= mkUnique '2' i
+mkPreludeClassUnique i          = mkUnique '2' i
 
 -- Prelude type constructors occupy *three* slots.
 -- The first is for the tycon itself; the latter two
@@ -303,11 +342,10 @@ mkTupleDataConUnique Unboxed a	= mkUnique '8' (2*a)
 isTupleKey u = case unpkUnique u of
 		(tag,_) -> tag == '4' || tag == '5' || tag == '7' || tag == '8'
 
-mkPrimOpIdUnique op		= mkUnique '9' op
-mkPreludeMiscIdUnique i		= mkUnique '0' i
+mkPrimOpIdUnique op         = mkUnique '9' op
+mkPreludeMiscIdUnique  i    = mkUnique '0' i
 
--- No numbers left anymore, so I pick something different for the character
--- tag 
+-- 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.
@@ -324,5 +362,18 @@ 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
+
+mkRegSingleUnique, mkRegPairUnique, mkRegSubUnique, mkRegClassUnique :: Int -> Unique
+mkRegSingleUnique = mkUnique 'R'
+mkRegSubUnique    = mkUnique 'S'
+mkRegPairUnique   = mkUnique 'P'
+mkRegClassUnique  = mkUnique 'L'
+
+mkVarOccUnique, mkDataOccUnique, mkTvOccUnique, mkTcOccUnique :: FastString -> Unique
+-- See Note [The Unique of an OccName] in OccName
+mkVarOccUnique  fs = mkUnique 'i' (iBox (uniqueOfFS fs))
+mkDataOccUnique fs = mkUnique 'd' (iBox (uniqueOfFS fs))
+mkTvOccUnique 	fs = mkUnique 'v' (iBox (uniqueOfFS fs))
+mkTcOccUnique 	fs = mkUnique 'c' (iBox (uniqueOfFS fs))
 \end{code}